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Introduction  to  Linear  Algebra  Calculator 

This  program  solves  the  two  major  problems  of  linear 
algebra:  (1)  the  determination  of  the  eigenvalues  and 
eigenvectors  of  a  square  matrix  "A"  and  (2)  the  solution  of 
simultaneous  equations  "A  X  =  B"  for  an  n  by  n  invertible  matrix 
"A"  and  any  n  by  m  matrix  "B" .  One  must  use  the  built-in  matrix 
editor  to  enter  the  matrices  "A"  and  "B".  A  program  ,  based  on 
eigenvalues  of  a  companion  matrix,  to  calculate  the  roots  of  a 
polynomial  with  real  coefficients  is  also  included.  The  source 
code  of  the  mathematical  routines  and  l/u  routines  could  be  used 
to  build  a  more  elaborate  matrix  calculator  that  might  include 
disk  I/O,  a  more  flexible  editor,  addition  and  multiplication  cf 
matrices,  and  a  matrix  expression  evaluator.  This  program  does 
not  have  these  capabilities. 

The  hardware  configuration  necessary  to  run  this  program  is 
an  IBM  PC  with  128K  of  RAM  memory  and  one  double-sided  drive.  It 
is  written  in  Pascal  MT  +  and  thus  the  source  code  could  be 
compiled  with  any  MT+  compiler  after  making  a  few  modifications 
to  the  system  I/O  routines.  Depending  upon  what  floating  point 
library  is  linked  in  with  the  compiled  code,  the  program  may  be 
run  with  an  8J87  chip  or  an  8088  chip. 

To  run  the  program  one  may  do  any  one  of  the  following:  (1) 
if  the  machine  is  off,   insert  the  progam  diskette  in  drive  A  and 


turn  the  power  on;  CPM-86  will  be  loaded  and  the  program,  called 
MATRIX,  will  be  executed;  (2)  if  the  machine  is  on,  insert  the 
diskette  in  drive  A  and  do  a  warm  boot  by  pressing  "Ctrl-Alt-Dei" 
simultaneously;  CPM-86  will  be  loaded  and  the  program  will  be 
executed;  or  (J)  if  CPM-80  has  been  loaded,  insert  the  diskette 
in  drive  A,  make  the  CPM  prompt  say  A>,  and  key  in  MATRIX 
followed  by  carriage  return.  There  are  obviously  other 
possibilities.  The  program  and  all  its  overlays  could  be 
transferred  to  RAM  disk  M  and  executed  from  there  with  M  also  the 
default  drive.  One  must  always  have  the  program  and  its  overlays 
oa  the  default  drive  because  the  program  looks  for  its  overlays 
on  the  default  drive. 

Brief  instructions  on  how  to  use  the  program  will  now  be 
given.  When  the  program  is  executed,  the  main  menu  is  displayed. 
by  pressing  "G",  one  can  view  some  very  brief  instructions.  They 
are  intended  for  somebody  who  has  never  run  the  program  before  or 
who  does  not  like  to  read  documentation.  Before  doing  any  matrix 
work,  one  must  press  "F"  to  bring  up  the  matrix  editor  and 
displayer.  The  menus  are  self-explanatory  and  channel  the  user  in 
the  desired  directions.  To  do  matrix  work  one  must  enter  a  matrix 
"A"  buc  the  entering  of  "B"  is  only  necessary  for  solving  "AX  = 
B" .  Only  one  matrix  "A"  and  one  matrix  "B"  may  be  stored  at  a 
time.  To  enter  a  new  matrix  after  one  has  already  been  created 
one  must  answer  "Y"  to  the  erase  prompt. 

When  matrices  "A"  and  "B"  are  first  created,  they  are 
initialized  at  all  zeros.  The  user  then  edits  the  matrix  in 
increasing   column   order.   Bach   column  will   be   displayed   for 


editing.  If  one  answers  "Y"  to  the  column  correct  prompt,  then 
the  next  column  will  be  displayed  for  editing.  If  one  answers 
"N",  the  cursor  will  be  positioned  at  the  entry  in  the  first  row 
of  that  column.  If  one  wants  to  change  that  entry,  he  enters  a 
new  number  followed  by  return.  If  one  simply  enters  return,  the 
entry  is  not  changed  and  the  cursor  is  positioned  at  the  next 
row.  After  the  entire  column  has  been  edited,  the  column  is 
redisplayed  with  the  same  prompt.  To  edit  column  4,  one  is  forced 
to  first  view  and  answer  "Y"  to  the  first  three  column  correct 
prompts.  A  compromise  on  flexibility  and  editing  speed  for  user 
friendliness  and  less  programming  has  been  made  here. 

Once   "A"  has  been  entered,   one  may  return  to  the  outer  menu 

to  calculate  tne  inverse,  determinant,  eigenvalues,  and 
eigenvectors.   If  "B"  has  been  entered  also,  one  can  press  "C"  to 

solve  a  linear  system  "A  X  =.B".  One  can  solve  for  the  roots  of  a 

polynomial   by  pressing  "A" .   One  enters  the  coefficients  of  the 

polynomial  within  this  segment  of  the  program,  not  in  tne 
editor . 

Two  possible  I/O  problems  are  the  following:  (1)  real  numbers 

are   not  filtered  for  underflow  or  overflow  when  inputted;   tiiey 

have   to  be  entered  in  the  interval  Ll.J  E-3U7,  1.0  E+307J;   and 

(2)  the  printer  must  be  on-line  (  or  must  be  put  on-line  when  the 

CPM-86  error  message  is  displayed)  if  a  hardcopy  is   desired.   If 

one  cannot  get  the  printer  on  line  after  a  hardcopy  was 
requested,  CPM-86  exits  the  user  back  to  a  system  prompt  and  the 
entered  matrices  "A"  and  "B"  are  lost. 


An  example  matrix  "A"  to  key  in  is  :  column  1  is  the  vector 
(1,3,6),  column  2  is  the  vector  (-3,-5,-6),  and  column  3  is  the 
vector  (3,3,4).  Let  X  and  r  (not  variables  in  the  Program  Matrix) 
stand  for  the  associated  eigenvector  and  eigenvalue  in  the 
equation  "AX=rX" .  The  eigenvalues  of  "A"  are  4,-2,  -2  and  the 
associated  eigenvalues  are  respectively  (1,1,2),  (-1,1,2)  and 
(1,3,2).  It  should  be  noted  that  eigenvectors  returned  by  the 
calculator  will  differ  by  scalar  multiples  from  those  above. 
Also,  keep  in  mind  instead  of  (-1,1,2)  and  (1,3,2)  which  are 
associated  with  the  eigenvalue  -2,  we  could  have  -another  pair  of 
eigenvectors  such  as  (U,4,4)  and  (2,2,u)  which  are  in  the  same 
eigenspace  as  the  first  pair.  The  inverse  of  the  matrix  "A"  is 
the  matrix  whose  columns  are:  (lj  . 125 (-1 , 3 , 6 ) ,  (2)  . 125 (-3,-7,  - 
6),  and  (3)  .125(3,3,2).  This  matrix  has  16  as  its  determinant. 
The  polynomial  X**3-6X**2+lIX-6  would  be  entered  as  the  vector 
( 1 , -6 , 11 , -b ) .  It  has  roots  1,2,3. 


Description  of  CRT  and  keyboard  utilities 

The  utility  programs  in  Module  CRTLIB  are  for  cursor 
control  and  filtered  input  of  characters,  integers,  and  real 
numbers.  This  section  should  be  read  concurrently  witii  the  source 
listing  of  Module  CRTLIB.  These  routines  are  based  upon  two  CPM- 
86  BIOS  .ills,  which  are  implemented  in  the  Procedure  Bioseull. 
Bioscall  has  two  input  parameters:  (1)  FUNC,  a  variable  of  cype 
CPMOPERATION  and  (2)  0CI1,  an  integer  variable.  Bioscall,  as 
presented  nere,  only  responds  to  two  inputs,  COL-JIN  and  CONUUT,  of 


type  CPMOPERATION. 

In  the  following,  terminal  character  refers  to  a  character 
that  is  being  sent  to  the  monitor  to  effect  a  cursor  control.  To 
send  a  terminal  character  to  the  CRT  interface (monitor ) ,  one 
calls  Bioscall  with  input  parameters  FUNC  equal  to  CUNOUT  and  OCH 
equal  to  the  ASCII  number  of  the  terminal  character.  The  value  of 
the  variable  BDOSVAL( integer  global  to  Module  CRTLIB)  is  not  used 
explicitly;  here  it  is  used  only  to  call  Procedure  @BDOS8o .  To 
read  a  character  from  the  keyboard,  one  calls  Bioscall  with  input 
parameters  FUNC  equal  to  CON IN  and  OCH  equal  .  to  any  dummy 
integer.  The  global  variable  BDOSVAL  is  set  equal  to  the  ASCII 
number  of  the  keyboard  character  pressed.  The  number  50  in 
@BDOS86(5iJ,  ADDR(DESCRIPTLl  J  )  )  is  the  BDOS  function  number  for  a 
BIOS  call.  Tiie  five  consecutive  bytes  allocated  oy  DESCRIPT  are 
used  for  passing  information  in  the  (^BDOSSto  call.  For  example, 
"DESCRIPT[1 J :=4"  is  the  Pascal  line  for  console  display  while 
"DESCRIPTL1]:=3"  is  the  line  for  keyboard  input.  The  Pascal  MT+ 
manual  gives  a  brief  description  of  the  MT+  utility  ^BDOSSb  while 
the  CPM-8G  manual  gives  a  detailed  discussion  of  BDOS  calls  in 
its  Appendix  D.  The  Procedure  Bioscall  presented  here  is  a  Pascal 
implementation  combining  (3BDOS86  with  the  BDOS  calls (for  function 
number  50)  of  CPM-86. 

One  could  expand  Procedure  Bioscall  to  include  all  the 
parameters  in  CPMOPERATION  by  combining  the  ideas  in  Bioscall 
with  Appendix  D  of  the  CPM-86  manual.  One  does  not  need  lo  use 
Bioscall  to  write  an  alpha-numeric  character  to  the  screen;  Write 
or  i/riteln  can  be  used  for  this .   Most  of  the  routines  in   Module 


CRTLIB  either  call  Bioscall  or  another  routine  which  calls 
Bioscall.  Function  Getchar  is  the  only  procedure  that  calls 
Bioscall  with  the  CONIN  parameter. 

In  order  to  use  the  utilities  in  Module  CRTLIB  one  must  call 
Procedure  Crtinit  at  the  beginning  of  the  main  program.  Crtinit 
initializes  the  arrays  CRTINFO  and  PREFIXED  so  that  their  values 
can  be  used  by  the  utilities  in  Module  CRTLIB. 

Function  Getchar,  using  Bioscall,  performs  the  task  of 
reading  a  character  from  the  keyboard.  The  input  .to  Getchar  is  a 
variable  set  of  characters,  called  O.KSET  in  Getchar '  s 
declaration.  When  Bioscall  is  called  by  Getchar  to  get  a 
character  from  the  keyboard,  Getchar  then  checks  to  see  if  the 
character  represented  by  BDOSVAL  is  in  OKSET.  If  it  is,  this 
character  becomes  the  value  of  the  Function  Getchar  and  is  used 
in  the  procedure  calling  Getchar;  if  it  is  not,  a  beep  is  sounded 
and  the  process  is  repeated  until  a  character  in  OKSET  is  finally 
entered.  This  version  of  Getchar  automatically  changes  lower  case 
to  upper  case.  An  example  of  Getchar  being  used  with  OKSETs  that 
are  dynamically  changing  can  be  seen  in  Procedure  Getreal . 

Procedure  Crt  is  ine  main  routine  that  calls  Procedure 
Bioscall  with  the  CONoUT  parameter.  Depending  on  the  boolean 
value  given  by  an  element  in  the  array  PREFIXED,  the  leuuin 
character,  ESC,  is  sent  to  the  monitor  and  then  the  actual 
terminal  character  is  sent  to  the  monitor.  For  example,  suppose 
we  want  to  clear  the  screen.  One  uses  the  variable  ERASEGo  of 
type   CtiTCGHMAND  as  the  parameter  input  to  Procedure   Crt.   Using 


ERASEOS  as  the  index  variable,  Crt  sends  the  leadin  character 
ESC  to  the  monitor  since  PREFIXED[ERASEOS]  is  true  and  then  sends 
the  character  'J',  which  is  CRTINFO[ERASEOS] .  It  should  be  noted 
that  in  the  above,  the  ASCII  numbers  of  the  various  characters 
are  actually  inputted  to  Bioscall  in  Procedure  Crt. 

One  can  control  background  colors  by  using  the  type  COLOR, 
the  arrays  COLORINFO,  CRTINFO,  and  PREFIXED  along  with  the 
Procedures  Initcolor,  Altcolor,  and  Paint.  One  then  needs  to 
write  a  procedure  similar  to  Altcolor  to  change  foreground 
colors.  These  would  be  the  fundamental  library  routines  for  using 
colors . 

Procedure  Gotoxy (X,Y: INTEGER )  ,  which  also  calls  Bioscail 
with  input  parameter  CONOUT,  places  the  cursor  at  vertical  line 
number  X  and  horizontal  line  number  Y.  The  other  cursor  control 
routines  are  fairly  obvious  in  view  of  the  above  discussion. 

Procedure  Intread  is  used  to  read  an  integer  between  -3276b 
and  +327o7.  The  characters  are  filtered,  put  into  a  string, 
checked  for  the  proper  range,  and  then  converted  to  Jin  integer. 
Intread  requires  an  integer  to  be  entered;  one  cannot  simply 
enter  carriage  return.  Procedures  Getreal  and  Value  are  used 
together  to  read  a  real  number.  Some  explanation  is  required  on 
the  use  of  Getreal.  In  the  procedure  calling  Getreal,  we  have  a 
string  variable,  SREEL,  initialized  at  ' ' ,  an  empty  string  of 
length  zero  but  still  a  string.  Procedure  Getreal  reads  and 
dynamically  filters  a  string  of  characters  and  if  this  string  is 
of   length   greater  than  zero,   this  string  is   returned   to   the 


calling  procedure  by  Getreal  and  SREEL  is  set  equal  to  it.  If 
Getreal  only  reads  a  carriage  return,  then  SREEL  remains  only  an 
empty  string  and  Procedure  Value  is  not  called.  If  SREEL  has 
length  greater  than  zero,  Procedure  Value  calculates  the  real 
number  corresponding  to  SREEL.  Getreal  and  Value  are  used  to  edit 
a  real  number  that  already  exists,  either  through  initialization 
or  calculation.  By  pressing  carriage  return,  one  can  leave  un 
existing  real  number  as  is.  This  use  eliminates  a  computer  crash 
caused  by  keying  m  only  a  carriage  return  when  the  usual  READ  or 
READLN  wants  an  actual  number.  Procedure  Value  was-  taken  from  The 
Byte  Book  of  Pascal  while  Procedure  Powrten  is  from  the  Pascal 
Users  Manual  by  Jensen  and  Wirth. 


Data  and  Overlay  Description 

This  program  illustrates  the  use  of  module  overlays,  an 
ordinary  module,  matrix  types  and  external  variables.  This 
description  explains  the  manner  in  which  the  program  was 
implemented,  and  therefore  it  stiould  oe  used  as  u  guide  to 
understanding  the  structure  of  the  code.  Modules  are  separately 
compiled  groups  of  procedures.  There  tire  two  types:  il)  an 
overlay  module  and  (2)  an  ordinary  module  which  must  be  linked 
with  an  overlay  module  or  main  program.  The  Module  CRTLIB  is 
separately  compiled  and  linked  in  with  the  main  program.  CRTLIB' s 
subroutines  essentially  become  a  part  of  the  main  program^, 
sometimes  called  the  root  overlay)  and  always  are  resident  in  RAM 
memory.   Since   the   utilities   in  CRTLIB  are   continually   being 
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called,  it  would  not  be  practical  to  make  CRTLIB  an  overlay 
module  and  thus  force  a  lot  of  disk  accesses.  If  a  module 
overlay!  including  the  main  program)  uses  a  procedure  in  Module 
CRTLIB,  then  the  "calling"  overlay  must  declare  the  procedure  as 
an  external  procedure  in  the  calling  overlay's  declaration 
heading  just  below  the  variable  declarations. 

The  data  storage  of  the  program  will  now  be  explained.  The 
controlling  data  allocation  declarations  are  (1)  the  TYPE 
DOMAIN  1  =  1  ..  2ij,  (2)  the  CONST  MAXDEG=2b,  (3)  the  CONST 
MAXDEGP1=21,  and  (4)  the  TYPE  D0MRP1=1 . . MAXDEGP1 .  MAXDEG, 
MAXDEGP1 (=MAXDEG  PLUS  1),  and  D0MRP1  are  used  to  solve  for  roots 
of  a  polynomial.  D0MAIN1  is  the  maximum  dimension  of  a  matrix 
entered  as  input  data.  MAXDEG  should  De  set  to  be  less  than  or 
equal  to  the  value  of  the  D0MAIN1  upper  bound  since  the 
polynomial  root  finding  technique  uses  jlx\  n  by  n  matrix  to  solve 
an  n  degree  polynomial  equation.  In  this  program,  the 
coefficients  of  a  polynomial  are  not  stored  in  a  global  variable! 
for  the  main  program)  and  there  is  not  much  I/O  to  go  with  tne 
polynomial  routine.  It  is  included  as  a  side  Denefit  to 
illustrate  the  use  of  the  eigenvalue  procedures  as  subroutines  to 
another  procedure.  Variables  that  are  referred  to  as  global  are 
declared  in  the  main  progrcim  and  then  declared  external  in  the 
overlays  that  use  them.  The  matrix  "A"  whose  square  dimension 
is  IONDIM  is  stored  in  the  upper  left-hand  corner  of  the  global 
variable  IOTA  and  the  matrix  "B"  whose  dimension  is  ROWDIMB  ay 
IOM  is  stored  lnthe  upper  left-hand  corner  of  the  global  variable 
iOTB.   IOTA,   10TB,   IONDIM,  R0WDIM3,  and  IOM  are  declared  in  the 


root  overlay(  Program  Matrix)  and  referenced  in  the  appropriate 
overlays  by  declaring  them  as  external  variables.  The  global 
matrix  "XX"  is  used  to  store  the  solution  to  "AX=B"  and  is 
referenced  as  external  in  Module  0verlay2U(  whose  source  code  is 
AXEUSB.SRC).  The  global  vectors  TEVR,  TEVi  store  the  real  and 
imaginary  components  of  the  eigenvalues  and  are  referenced  as 
external  in  Module  Overlay24(  EIGENVEC . SRC ) .  The  global  matrix 
TVEC,  referenced  as  external  in  Module  Overlay24,  is  used  to 
store  the  eigenvectors  of  the  matrix  "A" .  Communication  of  data 
between  the  root  overlay  (Program  Matrix)  and  the  overlay 
modules  j? i ,  #19,  #20 ,  #24  is  accomplished  by  initially  declaring  the 
above  mentioned  variables  in  the  main  program  and  by  declariny 
them  external  in  the  necessary  overlay  modules.  The  Types  of 
matrices  and  vectors  must  be  declared  in  the  root  overlay  and 
redeclared  in  the  overlay  modules.  When  using  dimensions  less 
than  the  maximum  allocated  in  the  Types,  all  data  will  be  stored 
in  the  upper  left-hand  corner  of  matrices  or  beginning  components 
of  a  vector.  Intermediate  results  produced  by  Module  Overlayl 
(LINSYS.SRC) ,  Module  Uverlay5  (EIGENHQR. SRC ) ,  and  Module  Overlays 
^EIGENBAL . SRC )  are  passed  as  parameters  in  the  procedure  calls. 

The  root  overlay  (Program  Matrix)  calls  directly  six  main 
procedures  located  in  six  overlays.  They  are  (1)  Procedure 
Matrixio,  located  in  Module  0verlay3,  which  is  the  editor  for 
matrix  input,  (2)  Procedure  Help,  located  in  Module  0verlay2j, 
which  is  a  brief  set  of  instructions  on  how  to  run  che  program, 
(J)  Procedure  Ttrdet,  located  in  Module  0verlayl9,  which 
calculates  the  determinant  of  the  matrix  stored  in  variable  IOTA, 
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(4)  Procedure  Ttsaxb,  located  in  Module  0verlay20,  which  solves 
"AX=B"  for  "A"  stored  in  the  variable  IOTA  and  "B"  stored  in  the 
variable  IOTB  or  "B"  is  the  identity  matrix(  used  to  calculate 
the  inverse  of  "A"),  (5)  Procedure  Ttrnaa,  located  in  Module 
Overlay24,  which  calculates  eigenvectors  and  eigenvalues  of  the 
matrix  stored  in  IOTA,  and  (b)  Procedure  Ttrpqr,  located  in 
Module  0verlay21,  which  calculates  the  roots  of  a  polynomial  with 
real  coefficients.  These  six  procedures  which  are  located  in 
module  overlays  must  be  declared  external  in  the  root  overlay 
heading.  After  the  word  "External",  the  overlay  number  to  which 
the  procedure  belongs  must  appear  in  square  brackets. 

Other  external  procedures  used  within  these  overlays  do  not 
have  to  be  declared  within  the  root  overlay;  they  are  aeclared  us 
external  procedures  with  the  appropriate  overlay  numbers  within 
the  overlay  that  calls  them.  For  example,  Procedure  Ttrdet, 
located  in  Overlay  Modulel9,  calls  Procedure  Rlud,  located  in 
Overlay  Modulel .  Therefore,  '  Procedure  Rlud  must  be  declared 
external  in  the  heading  of  Module  0verlayl9.  Module  Overlay J  uses 
procedures  located  in  the  Module  CRTLIB(  not  an  overlay  modulo ), 
ana  therefore  these  called  procedures  must  be  declared  as 
external  in  the  neading  of  Module  Overlay3.  Tiiese  external 
procedures  from  Module  CRTLIB  do  not  have  overlay  numbers . 

Module  Overlay3  ( IOMATRIX . SRC )  is  the  module  responsible  for 
keyboard  input  of  matrices  and  printer  output  of  matrices.  The 
maximum  size  of  the  matrix  is  set  in  the  TYPE  D0MAIN1  =  1 .  . 20 .  If 
one  wanted  only  matrices  of  dimension  10  or  less,  one  would  sec 
TYPE  DuMAINl  =  1 . . 1U .  One  must  change  these  type  declarations  for 
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all  the  overlays  that  use  them.  It  should  be  noted  that  che 
editing  programs  are  based  upon  editing  a  column  of  a  matrix  that 
fits  onto  one  screen  display.  If  one  wanted  to  enter  a  column  of 
dimension  larger  than  twenty,  the  column  display  and  editing 
routines  would  have  to  be  modified  a  little.  On  the  other  hand  it 
is  not  practical  to  enter  a  matrix  larger  than  10  by  1U,  let 
alone  2u  by  20.  Large  matrices  should  be  generated  by  a  program 
or  read  from  a  disk  file.  For  example,  Module  Polyroot  generates 
a  20  by  20  matrix  when  one  requests  the  root  of  X**20=l. 

Within  this  module,  Procedure  Getcolumn  and  Procedure 
Gotpolcof  are  the  work  horses.  Respectively,  they  take  the  column 
of  a  matrix  or  the  coefficients  of  a  polynomial  and  display  them 
on'  the  screen  for  editing.  These  two  routines  use  the  cursor 
control  utilities  and  Procedures  Intread,  Getreal,  and  Value  to 
edit  existing  columns.  Procedure  Matrixio  is  the  editing 
procedure  which  calls  the  Procedures  Edit  and  Display.  Edit 
displays  menus,  initializes  matrices,  and  calls  the  above 
mentioned  procedures  to  edit  existing  matrices.  Procedure 
Display,  which  is  somewhat  redundant,  gives  a  faster  display  than 
Procedure  Edit.  Procedure  liurdcopy  is  used  to  printout  the 
matrices  "A",  "B",  inverses,  determinants,  matrix  equation 
solutions,  eigenvectors,  and  eigenvalues. 

Module     Uverlay24     (EIGENVEC . SRC ) ,      Module     OverlayG 
(EIGENBAL.SRC) ,    and   Module   Overlays   (EIGENHQR.SRC)   are   the 

overlays  which  calculate  eigenvectors  and  their  corresponding 
eigenvalues.   Procedure   Ttrnaa   takes   the   global   matrix   IOTA 
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containing  the  matrix  "A"  and  its  dimension,  IONDIM,  and  calls 
the  Procedure  Rnaa .  Procedure  Rnaa  is  the  procedure  which  calls 
the  Procedures  Balance,  Elmhes,  Eltran,  Hqr2,  and  Balbak,  which 
together  calculate  the  eigenvalues  and  eigenvectors.  The 
eigenvalues  are  returned  to  Ttrnaa  in  the  global  arrays  TEVR  and 
TEVI.  TEVRdJ  and  TEVl[l]  givci  the  real  and  imaginary  parts  of 
the  eigenvalue  #1.  The  eigenvectors  are  returned  in  the  matrix 
TVEC  in  a  not  so  obvious  way.  They  are  returned  in  an  order 
corresponding  to  the  eigenvalues  in  TEVR  and  TEVI.  The  manner  in 
which  TVEC  returns  the  eigenvectors  needs  to  be  illustrated  by  an 
example.  Let  TEVRLlJ=l  and  TEVIL1]=2;  the  eigenvalue  is  l+2i. 
Then  TEVR[2]=1  and  TEVl[2j=-2  since  eigenvalues  and  eigenvectors 
of  real  matrices  occur  in  conjugate  pairs.  Now  the  two 
eigenvectors  that  correspond  to  these  eigenvalues  are  conjugates. 
TVEC  in  its  first  column  will  have  the  real  part  of  eigenvector 
ffl  and  in  its  second  column  it  will  have  the  imaginary  part  of 
eigenvector  #1.  Eigenvector  #2  will  just  be  the  conjugate  of  this 
eigenvector.  If  the  eigenvalue  is  pure  real,  then  the  eigenvector 
is  pure  real  and  only  one  column  is  necessary.  In  the  case  of  a 
matrix  with  repeated  eigenvalues  without  a  full  set  of 
eigenvectors,  the  eigenvectors  will  be  repeated  in  the  matrix 
TVEC (  probably  numerically  slightly  different).  These  eig^nveccor 
subroutines  are  Pascal  translations  by  the  author  of  EISPACK 
eigenvector  routines  in  Fortran. 

Module  Overlay21  t POLYROOT . SRC )  also  uses  >_he  eigenvalue 
subroutines  to  solve  for  the  roots  of  a  polynomial  with  real 
coefficients.  It  makes  the  integer  1  the  leading  coefficient  of  a 
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polynomial  of  degree  n  and  enters  the  other  n  coefficients  into 
the  first  row  of  an  n  by  n  matrix  with  l's  on  the  subdiagonal; 
this  matrix  is  called  the  companion  matrix  and  the  eigenvalues  of 
it  are  the  roots  of  the  polynomial.  Procedure  Ttrpqr  does  the 
preliminaries  and  Procedure  Rpqr  calls  the  sequence  of  eigenvalue 
subroutines  to  find  the  eigenvalues  whicn  are  returned  in  the 
variables  TWR  and  TWI .  Procedure  Balbak  is  not  used  since  the 
eigenvectors  are  not  needed.  POLYROOT.SRC  illustrates  the  use  of 
these  subroutines  in  a  real  problem  and  it  also  serves  as  a  test 
of  the  correctness  of  the  eigenvalue  codes. 

Module  Overlay20  (AXEQSB . SRC )  and  Module  Overlay! 
I LIN3YS . SRC)  are  the  overlays  which  solve  systems  "AX=B"  as  well 
dS  find  the  inverse  of  the  matrix  "A"  (B  will  be  the  identity 
matrix  in  this  case).  Again  the  "A"  matrix  is  in  IOTA  and  the  "B" 
matrix  is  in  IOTB.  Procedure  R*LUD  does  an  L-U  decomposition  on 
the  matrix  in  the  variable  SA(  the  constant  matrix  SB  tags  along) 
and  Procedure  Rfbs  does  the  back  substitution  to  solve  the 
system.  In  the  case  where  "B"  has  more  than  one  column,  Rfbs  is 
called  IOM  times  to  solve  the  equations.  Procedures  Rlud  and  Rfbs 
are  Pascal  translations  by  the  author  of  a  Sandia  Labs  matrix 
equation  solver;  it  is  very  successful  with  matrices  "A"  that  are 
almost  singular(no  inverse). 

Module  Overlayl9  (DETERM.SRC)  and  Module  Overlay 1 
( LIbJSYS .  SKC)  are  used  to  calculate  determinants.  Rlud  in 
LINSYS.SRC  does  an  L-U  decomposition  of  the  matrix  TALU (  a  copy 
of  IoTA)  and  returns  the  L-U  decomposition  in  TALU.  The  matrix  L 
has   ones   on  the  diagonal  and  therefore  the  determinant   of   "A" 

14 


will   be  the  determinant  of  "U"  which  is  just  the  product  of   U's 
diagonal  entries. 

Layout  of  Overlays 

Module  overlays  are  divided  into  groups.  Overlays  #1  -#16 
are  in  overlay  group  #lf  overlays  #17-#32  are  in  overlay  group 
%2,  etc..  The  source  code  of  an  overlay  module  must  begin  with 
its  identification  number;  for  example  overlay  module  #1  L...3  the 
heading,  Module  Overiayl.  The  root  overlay  is  just  the  main 
program;  here  it  is  Program  Matrix.  This  program  does  not  use  the 
most  sophisticated  overlay  structure.  In  this  program,  overlays 
within  the  same  group  do  not  call  each  other  and  there  is  no 
heap.  When  compiling  an  overlay,  one  does  not  have  to  specify  the 
address  in  RAM  memory  where  the  overlay  will  be  loaded .  This  is 
done  during  the  linking  process.  All  the  overlays  within  the  same 
group  must  be  located  at  the  same  address.  This  address  must  be 
larger  than  the  length  of  the  root  overlay  including  any  runtime 
library  routines  or  oruinary  modules  linked  ^ith  the  root 
overlay.  For  example,  the  root  overlay,  Program  Matrix  with 
routines  from  the  libraries  TKANCEND. R86 ,  87REALS.R86, 
PASLIB.R86,  and  Mouule  CRTLIB  use  bFFCii(hex)  bytes  of  storage. 
The  uiemory  allocated  for  overlay  group  #1  must  be  some  address 
larger  than  this;  here  86UUII  is  used.  In  tiie  linking  instructions 
below,  overlays  #1  -  #16  must  be  directed  to  begin  at  86UU11.  Then 
one  looks  at  the  largest  length  of  the  compiled  overlays  in  group 
#1  and  adds  this  to  860Uli.  In  this  program,  Module  Over  lay  5  has 
length   42AAH.   This   should   be  verified   again   after   all   che 
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overlays  in  group  #1  have  been  linked  to  the  root  overlay.  One 
adds  8600H  to  42AAH  to  obtain  the  length  C8AAH .  The  address  where 
overlays  417  -  £32  begin  must  be  larger  than  C8AAH.  This  program 
uses  address  D200H  for  the  location  of  overlays  in  group  #2.  The 
overlay  of  the  largest  length  in  group  #2  is  Module  0verlay21 
with  a  length  of  1370H.  1370H  plus  D200H  equals  E570H.  Therefore, 
the  total  length  of  the  code  that  must  be  specified  in  the  last 
link  command  with  the  R  switch  must  be  greater  than  E570H.  The 
value  used  is  FC0OH.  The  data  storage  required  is  only  that  from 
those  variables  declared  in  the  main  program  and  it  is  576CU. 
The  value  8000H  is  more  than  adequate  and  is  declared  with  the  D 
switch  in  the  last  linker  command.  Local  variables  and  parameters 
are  stored  in  the  stack.  This  stack,  is  automatically  given  J2K 
bytes  of  RAM.  One  can  actually  assign  the  stack  size  by  using  the 
Z  switch  in  the  last  linker  command.  For  example,  "z./3uu"  will 
assign  3000H  for  stack  memory.  Liote  that  3U0  here  means  3000H  or 
12K  bytes. 

One  has  to  make  sure  the  total  RAM  allocated  for  data,  coue , 
stack,  and  heap  is  smaller  than  the  RAM  allocated  for  program 
execution.  Otherwise,  upon  program  execution,  a  "Memory  not 
available"  message  will  be  displayed.  In  this  program,  the  stack 
was  reduced  to  12K  in  order  that  the  program  would  execute  in  a 
128K  machine.  Having  a  stack  too  small  is  a  potential  problem, 
but  by  far  the  major  source  of  problems  is  having  one  overlay 
group  overwrite  another.  Apparently,  one  needs  to  have  some 
memory  available  between  the  end  of  the  largest  overlay  in  a 
particular   group  (including  the  root  overlay)  and  the   beginning 
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of  the  next  overlay  group.  For  example,  in  this  program  when  the 
addresses  7200H,  B800H,  and  DE00H  were  used  in  place  of  the 
addresses  8600H,  D200II,  and  FC00H  the  program  would  not  execute 
properly.  The  Pascal  MT+  manual  should  address  this  problem.  if 
one  experiences  weird  program  execution,  the  distance  between 
overlay  groups  should  be  increased  as  the  first  approach  to  solve 
the  problem. 

Computer  Configuration  for  Pascal  MT+ 

In  doing  developmental  work  for  this  program,  the  IBM  PC  was 
configured  with  two  DS/DD  disk  drives,  512K  of  RAM,  ana  the  CPM- 
S6  operating  system.  The  RAM  was  partitioned  into  140K  for 
running  programs (compiler ,  editor,  linker,  and  the  executable 
linear^  algebra  routine)  and  372K  for  a  RAM  disk,  called  the  M: 
drive.  The  program  SETUP.CMD,  furnished  with  CPM-86,  was  used  to 
configure  the  RAM  drive  and  the  cursor  pad  of  direction  arrows. 
Upon  bootup,  the  RAM  drive  is  created  and  the  cursor  pad  is 
initialized . 

A  RAM  disk  is  essential  (though  not  required)  for  program 
development  with  Pascal  MT+  because  of  the  heavy  disk  access  by 
the  MT+  Speed  Editor,  Compiler,  and  Linker  of  their  overlays  and 
the  program's  source  and  object  code  files.  If  one  follows  the 
implementation  techniques  described  in  the  following,  the  user 
will  find  MT+  not  just  a  powerful  Pascal  implementation,  but  one 
that  possess  good  development  time  and  is  not  cumbersome.  It 
should   be   mentioned   that  in  many  articles   comparing   the   MT+ 
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implementation  to  others,  the  benchmarks  involving  compile  and 
link  times  are  misleading.  Pascal  MT+  uses  a  lot  of  disk  I/O 
because  of  its  code  size  and  this  eats  up  a  lot  of  time.  Using  a 
RAM  disk  reduces  this  I/O  time  considerably. 

One  must  configure  three  diskettes.  Diskette  #1,  called  the 
compiler  diskette,  must  contain  CPM.SYS(  configured  for  RAM  drive 
and  optionally  the  cursor  pad),  the  MT+  compiler (  consisting  of  a 
CMD  file  and  its  several  overlays),  and  three  R86  files:  (1) 
87REALS.R86,  (2)  PASLIB . R86 , and  (3)  TRANCEND . R86 .  It  is  optional, 
but  useful  to  put  the  utility  routines  such  as  PIP. CMD  and 
STAT . CMD  on  the  compiler  diskette.  Diskette  #2,  called  the  editor 
diskette,  should  contain  the  Speed  Programmrning  Editor (  CMD  file 
and  its  overlays;,  SIP. CMD (  PIP. CMD  renamed  by  the  user),  anu 
STAT. CMD.  Diskette  ff3,  called  the  linker  diskette,  should  contain 
the  MT+  linker (  CMD  file  and  its  overlays)  and  the  SUBMIT.CMD 
file.  For  single  stroke  execution,  it  is  convenient  to  rename  the 
compiler,  editor,  and  linker  respectively  M.CMD,  S.CMD,  and 
L . CMD . 

The  following  is  the  start  up  process.  Put  the  compiler 
diskette  in  drive  A:  and  the  editor  diskette  in  drive  B:  and  then 
turn  the  power  on.  When  the  "A>"  prompt  comes  up,  key  in  "PIP 
M:=B:S*.*".  This  will  transfer  the  editor,  SIP. CMD,  and  STAT. CMD 
to  the  M:  drive.  One  can  use  an  editor  other  than  DRI ' s  Speed 
Editor.  Users  of  UCSD's  P-Editor  will  find  the  Speed  Editor 
acceptable  when  not  in  the  P-system.  After  the  editor  is 
transferred  to  RAM  drive,  one  removes  the  editor  diskette  from 
drive  B:   and  inserts  a  work  diskette  containing  source  and  their 
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compiled,  R86,  files. 

One  then  presses  Control-C  and  changes  the  default  drive  to 
M: .  if  one  wants  to  edit  an  existing  source  file,  one  us^s 
SIP.CMD  on  drive  M:  to  "pip"  the  source  file  from  drive  3:  to 
drive  M:  .  While  in  the  M:  drive,  one  edits  a  Pascal  source  file. 
If  one  is  using  the  Speed  Editor,  a  word  of  caution  is  necessary. 
If  one  attempts  to  save  a  file  on  a  drive  without  enough  memory ( 
including  RAM  drive),  the  old  source  file  as  well  as  the  source 
file  in  the  editor's  buffer  will  be  lost.  This  potentially 
serious  problem  can  be  avoided  if  one  is  aware  of  it.  If  the 
Speed  Editor  is  used  one  should  use  its  syntax  scanner  and 
variable  checker  to  locate  syntax  errors  and  typos  prior  to 
compilation. 

Once  a  source  file  has  been  edited  it  must  be  compiled.  It 
is  not  necessary  to  transfer  the  compiler  to  RAM  drive.  One  must 
change  the  default  drive  from  M:  to  A: ,  leaving  the  compiler 
diskette  in  drive  A:  and  the  source  file  on  RAM  drive.  Since 
Pascal  MT+  is  oriented  toward  modularity  and  modular  compilation 
in  particular,  individual  source  files(  modules  and  overlay 
modules  )  are  relatively  short.  Because  of  this,  disk  I/O  to 
drive  A:  to  load  the  compiler  overlays  is  not  too  frequent.  With 
the  source  code  being  read  from  RAM  drive  and  compiled  code  being 
written  to  RAM  drive,  compiles  are  quite  timely. 

To  compile  all  the  overlays  and  modules  for  the  linear 
algebra  calculator,  one  must  do  the  following  tasks.  There  are 
eleven   source  codes  which  must  be  saved  on  the  work   disk.   They 
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are  (1)  MATRIX. SRC,  (2)  CRTLIB.SRC,  (3)  IOMATRIX. SRC,  (4) 
EIGENBAL.SRC,  (5)  EIGENHQR. SRC ,  (6)  MHELP.SRC,  (7)  LINSYS.SKC, 
(8)  DETERM.SRC,  (9)  AXEQSB.SRC,  (10)  POLYROOT . SRC ,  AND  (11) 
EIGENVEC. SRC.  Each  file  should  be  transferred  to  RAM  drive  ana 
then  compiled.  To  compile  the  root  overlay,  MATRIX. SRC,  one 
enters  the  following  command:  "MT+86  M : MATRIX. SRC" .  If  one 
changed  the  name  of  the  compiler  to  M.CMD,  then  one  enters  "M 
M:MATRIX.SRC" .  The  compiler  will  compile  the  file  and  write  a 
code  file,  MATRIX. R86,  to  RAM  drive.  Similarly,  one  compiles  the 
other  ten  source  code  files  to  produce  ten  more  R86  coue  files. 
These  code  files  should  be  saved  on  the  work  diskette  in  urive 
B:.  It  should  be  emphasized  that  if  the  source  code  of  a  module 
or  overlay  module  is  not  changed,  then  it  does  not  nave  to  be 
compiled. 

The  most  important  implementation  method  in  MT+  code 
development  is  to  automate  the  linking  process.  Without  this 
automation,  the  linking  process  is  extremely  time  consuming. 
Automatic  linking  is  accomplished  by  using  SUBMIT.CMD  and  linker 
input  command  files,  called  KMD  files.  These  will  now  be 
described  in  detail  and  applied  to  the  linear  algebra  calculator. 
Once  all  the  overlays  have  been  compiled  one  makes  up  a  KMD  file 
for  each  compiled  overlay  module.  A  KMD  file  is  actually  a  text 
file  keyed  in  using  an  editor  and  given  the  suffix  KMD  instead  of 
the  usual  SRC  suffix.  The  following  KMD  text  files  are  needed: 

(1)  MkJ.KMD  with  the  line  of  source: 

M  :  MATRIX ,  M :  CRTLIB ,  M  :  TRAWCEND ,  M :  d7  REALS  ,  M  :  PASLIB/S  /'E/W 
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(2)  Ml.KMD  with  the  line  of  source: 

M: MATRIX. 001=M: MATRIX/0: 1 , M: LINSYS, M: PASLIB/S/P: 8600/L 

(J)  M3.KMD  with  the  line  of  source: 

M:MATRIX.003=M:MATRIX/O:3,  M:IOMATRIX,M:PASLIB/5/P:B60iJ/L 

(4)  M5.KMD  with  the  line  of  source: 

M: MATRIX. 005=M:MATRIX/O: 5, M:EIGENHQR,M:PASLIB/S/P: 8600/L 

(5)  Mb.KMD  with  the  line  of  source: 

M : MATRIX. 006=M : MATRIX/O :b,M:EIGEN3AL,M: PASLI B/S/P:86U J /L 
(b)  M23.KMD  with  the  line  of  source: 

M: MATRIX. 01 7=M:MATRIX/0: 23, M:MHELP,M:PASLIB/S/P:D200/L 
(7)  M19.KMD  with  the  line  of  source: 

M :  MATRIX  .  01 3=M:  MATRIX/0  :  1  9  ,  M  :  DETERM,  M  :  PASLI  B/S/  P  :  D20G  /L 
(b)  M2U.KMD  with  the  line  of  source: 

M : MATRIX . 014=M : MATRIX/0 : 20 , M : AXEQSB, M : PASLI B/S / P : D20O/L 
(9)  M21.KMD  with  the  line  of  source: 

M : MATRIX. 01 5=M: MATRIX/O : 21 , M : POLYROOT , M : PASLI B/S/ P : D2uu/L 
(lU)  M24.KMD  with  the  line  of  source: 

M : MATRIX. 018=M: MATRIX/0 : 24, M : EIGENVEC , M : PASLI B/S/P:D2JU/L 

21 


(11)  MR.KMD  with  two  lines  of  source: 

M : MATRIX , M : CRTLI B ,  M : TRANCEND , M : 87  REALS , /C 

M:PASLIB/S/D:8000/V1 : 8600/V2 : D2JQ/R: FCU0/Z : 300 

These  linker  input  command  files  are  stored  on  the  linker 
diskette.  As  with  the  editor,  RAM  drive  will  be  used  extensively. 
One  transfers  the  compiled,  R86,  files  from  the  work  diskette  to 
the  M:  drive.  Then  one  transfers  the  three  R86  library  files  to 
the  M:  drive:  (1)  87REALS . R86 ,  (2)  PASLIB.R8G,  and  (3) 
TRANCEND. R8b.  If  one  does  not  use  the  dk>87  chip  then  FPKEALS. R80 
must  be  used  in  place  of  87REAL.S  .  R86  .  At  this  point,  one  should 
remove  the  compiler  diskette,  and  insert  the  linker  diskette. 
Then  one  enters  Control-C  and  makes  h:  the  default  drive.  The 
input  command  files  save  a  lot  of  time  since  the  overlay  module 
names  and  addresses  rarely  change  during  program  development. 
Remember  that  the  linker  lias  been  renamed  L.CMD  for  keyboard 
simplicity.  Instead  of  keying  in:  "L  M: MATRIX, M: CRTLIB,  M: 
TRANCEND, M: 87REAL5 , M: PASLIB/ S/E/W"  one  simply  enters:  "L  M0/F" . 
Without  the  input  command  files  option,  one  wouLd  iiave  to  do 
eleven  links,  keying  in  by  hand  each  time  all  of  the  names  aiiu 
addresses  in  the  linker  input  command  files.  Instead,  one  merely 
executes  the  eleven  commands:  (lj"L  M0/F",  (2)"L  Ml/F",  (j)"L 
M3/F",  (4)  "L  M5/F",  (5)  "L  Mo/F",  (6)  "L  M23/F",  (7)  "L  M19/F", 
(8)  "L  M2U/F"  ,  (9)  "L  M21/F",  (10)  "L  M24/F",  (11)  "L  MR/F". 

une    can   further   automate   the   above   process   by    using 
SUBMIT.CMD   to  do  batch  processing  of  the  above  eleven   coinraanas . 
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To  do  this,  one  must  prepare  a  textfile,  with  the  suffix,  SUB.  In 
the  linear  algebra  calculator,  this  SUB  file  is  called 
MLTNK2.SUB.  In  this  text  file,  each  line  of  text  will  be  a  single 
command.  The  eleven  command  lines  of  this  textfile  will  be  the 
command  lines  of  the  above  paragraph.  It  should  be  noted  that 
this  SUBMIT.CMD  code  is  a  very  sensitive  code.  V/hen  the 
MLINK2.SUB  was  constructed  using  the  Speed  Editor,  the  batch 
process  would  not  execute.  If  MLINK2.SUB  was  constructed  using 
WORDSTAR  with  no  editing  changes,  it  worked  fine.  Also,  some 
editing  such  as  exchanges  gave  no  problem  while  deletes  did. 
SUBMIT.CMD  seems  to  perform  better  under  CCPM-86 . 

The  following  is  the  file  configuration  to  do  an  automatic 
link.  All  Rbb  files  including  compiled  source  files  ana  run-tirne 
libraries  umst  be  on  drive  M: •  The  linker  diskette,  in  drive 
A:, must  contain  L  .  CMD  and  its  overlays,  SUBMIT.CMD,  MLINK2.SUB, 
and  the  eleven  linker  input  command  files. 

With  A:  as  the  default  drive,  one  enters  "SUBMIT  MLINK2"  and 
the  linking  process  will  be  automatically  executed.  Once 
automated,  the  linking  process  is  not  a  big  hassle.  Linking  MT+ 
code  is  the  price  one  pays  for  modular  compilation.  The  link  will 
be  fairly  fast,  considering  the  size  of  the  codes.  The  fact  that 
the  R86  files  are  being  read  from  RAM  drive  and  the  final 
overlays  are  being  written  to  RAM  drive  creates  a  tremendous 
savings  in  time.  The  linker  will  create  ten  overlays:  (1) 
MATRIX.  CI-1D,  (2)  MATRIX.  001,  (3)  MATRIX.  003,  (4)  MATRIX.  0L»5,  (5) 
MATRIX. DUG,  (6)  MATRIX. 01 7,  (7)  MATRIX. 013,  (8)  MATRIX. ul 4,  (9) 
MATRIX.  01 5,   (10)  MATRIX.  018.   After  they  have  been  created,  they 
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should  be  transferred  to  another  diskette  to  be  saved  and 
executed  as  desired.  It  might  be  possible  to  put  the  linker  and 
its  overlays  and  the  KMD  files  on  RAM  disk  also  if  one  had  a 
larger  RAM  drive.  It  does  not  seem  that  there  is  a  tremendous 
loss  in  time  to  load  the  linker  overlays  and  read  the  command 
files  from  a  diskette.  If  the  R86  files  are  read  from  a  diskette 
and  the  compiled  overlays  are  wniten  to  a  diskette,  there  is  a 
tremendous  loss  of  time.  One  has  to  keep  in  mind  that  SUBMIT.CMD 
is  sensitive  to  the  selection  of  drives  that  have  the  files  that 
it  is  batch  processing.  It  seems  only  experimentation  tells  what 
SUBMIT.CMD  accepts;  it  went  for  the  above  configuration. 
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SOURCE    LISTINGS 

(*    VERSION    C2S5    *) 

PROGRAM    MATRIX; 

CONST    MAXDEG    =    20; 

MAXDEGP1    =    21; 

TYPE    DOMEP1    =    1..MAXDEGP1; 
DOMAIN1    =    1..2C; 

MATRIX    =     ARRAY  [DOMAINl,DOMAINl]     OF    REAL; 
LI3TI    =    ARRAY [DCMAINl]     OF    INTEGER; 
LISTR    =    ARRAY [DOMAINl]     OF    REAL; 
LISTRP1    =    ARRAY [DOMRP1]     OF    REAL; 
CRTCOMMAND    =     (2  RAO  SOS,  ERASEOL  ,  UP  ,DG;7M  ,  RIGHT  ,  LEFT  ,  LEAD  IN  ,  T  IME  , 

FCOLOR, BCOLDP , REVIDON , REVIDOFF , INTENON, IMTENOFF, 

3  L  I  N  K  C  N  t 

3LINK0FF) ; 
SETOFCHAR    =    SET    OF    CHAR; 
PTR    =    "INTEGER; 
CPMOPERATICN    =     ( C0LD3C0T  ,  UARM300T,  CONSTAT,  CON  IN  ,CCNOUT,  LI  FT, 

PUNCUT,RDRIN,HGME,SELDSK,SET..TRK,GETSEC,£ETD  12  , 
DSKREAD,DSKURITE) ; 
STRING40    =    STRING [4  0] ; 
STRINGG    =    STRING  [6]  ; 
STRING30    =    STRING  [SO]  ; 


err  r?r-,m  .      "•  t  t  t>  p  • 

~\  rr  /-"  tt1  rp  •        rrlrT1r  7n,H  rt  i 

AC  IFLAG,  IOBFLAG,QUITFLAG,SYMFLAG:     30CLEA:1; 

IOTA , TA , TVEC :    MATRIX ; 

ICT3/TEMPT3fXXl     MATRIX; 

TEV,TEVR,TEVI:     LISTR; 

S3LASTX,S3LASTY:     EXTERNAL    INTEGER; 

TEMPI OM  , TEMPI  0: 1 :     I  NTEGER ; 

GCEET:    REAL; 

(*     EXTERNAL    PROCEDURES  AND    FUNCTIONS    *) 

EXTERNAL    PROCEDURE  CRT  IN  IT; 

EXTERNAL    PROCEDURE  CRT (C : CRTCOMMAND) ; 

EXTERNAL    PROCEDURE  GOTOXY (X , Y : INTEGER) ; 

EXTERNAL    PROCEDURE  PROMPTAT ( Y : INTEGER; S : STRING) ; 

EXTERNAL    PROCEDURE  CLEAESCREEN; 

EXTERNAL    PROCEDURE  CLEARIT ( I : I NTECER) ; 

ryn-r"  — \  r      t[]-"'"7TO!'       "•  it  TT"  :  17  p  /  n  ,r ' :  "  rp  •  c  r  m  ^  ^  ^ '-'  A  Q  ^   •      fHlS  ■ 
L/Ai  LlMinLi      CUI^HUh       j^iw   l/u>   [•j,».jij1  .  ^  li  Ji.    ^.ir.  a)    •       ^- .  1 .  \  l*  , 

r.ljUl  VnK      J  .  J  1  i\  1  .      j  ,     i;-\  A  Li  _.  l  J  .        j.  i .  -   .      j  .  j  ,i  j    1 
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EXTERNAL  FUNCTION  YES:  BOOLEAN; 

EXTERNAL  PROCEDURE  WAIT; 

EXTERNAL  PROCEDURE  tfHEAD (S : STRING) ; 

EXTERNAL  PROCEDURE  INTREADCVAR  K: INTEGER); 

RHTERMAL  FUNCTION  VALUE(VAR  StSTRING;  VAR  P:INTEGER):  real; 

EXTERNAL  PROCEDURE  GETREAL (VAR  S : STRING ; MAXLEN : INTEGER) ; 

EXTERNAL  [2]     PROCEDURE  MATRIXIC; 

EXTERNAL  [23]  PROCEDURE  HELP; 

EXTERNAL  [19]  PROCEDURE  TTRDET; 

EXTERNAL  [20]  PROCEDURE  TTSAX3; 

EXTERNAL  [21]  PROCEDURE  TTRPQR; 

INTERNAL  [24]  PROCEDURE  TTRNAA; 

(*  END  OF  EXTERNAL  DECLARATIONS  *) 

PROCEDURE  PREAXB; 

(*  EAVES  3  WHILE  THE  INVERSE  OF  A  13  COMPUTED  *) 

VAR  I, J:  INTEGER; 

3EGIN  (*  PREAXB  *) 

IE  ICEFLAG  THEN 

TEMPICM  :=  ION; 
FOR  I:=l  TO  R0.7DIM3  DC 
FOR  J:=l  TO  ION  DC 

TEMPTS [I, J]   :=  I  GTE  [I, J]; 
TEMPION  :=  ECNDIHE; 
END; 
IC.-l  :=  ICNDIM; 
FOR  I:=l  TO  ICNDIM  DC 
FOR  J:=l  TO  ICNDIM  DC 
I0T3[I,J]  :=  0.0; 
FOR  I:=l  TO  ICNDIM  DC 

I OTB [1,1]  :=  1.0; 
TTSAXS ; 

IF  IC3FLAG  THEN 
BEGIN1 

ICM  :=  TEMPICM; 


NCR  I:=l  T' 


JWDIHB  DC 


FOR  J:=l  TO  I'OM  DC 

IOTB[I,J]  :=  TEMPTS [I, J]; 


END;   (*  PREAXE  *) 


BEGIN (*  MATRIX  *) 
CRT  I  MIT; 
QUITFLAG  :=  FALSE; 

AG  I  FLAG  :=  F^LSE; 
I02FLA3  :=  FALSE; 
REPEAT 

ZXEARSCESEN; 

''iPiri  /  t  r  T'l^^C    r  rmu!   "Sf'Tir  IT^D'  \  • 


sotoxy(C 
,/ritel::  ( 

WRITELK; 

.Jriteln  ( 


:  o 


•  -  ; 


JRITELM; 
WRITELN ( 
WRIT ELM; 
WRIT ELM  ( 
WRITSLM; 
WRITELN ( 
WRITELN; 
WRITELN ( 
WRITELN; 
WRITELN  ( 
WR ITELM ; 
WRITELN  ( 
WRITELN; 
WRITE (' 
IF  ACIEL^G  THE?-] 
BEGIN 

~\  rr  <-  p  rn    .  _     [Ml        1  T?  1  "]      f  I  n    '  1   • 
,.'"....  j  i    •  .A    •  •    L  j_    -_^    j  j 

IF  IOBFLAG  THE!' 
3EGIM 

IF  ROWDIMB=IONDIM  THEM 
: VS ET  :=  OKSET+  [  ' C'  ]  ; 


•  -J  f  V 


'REAL  POLYNOMIAL  ROOT  SOLVER'); 

'  ErSENVECTOP.G  OF  REAL  IATRIX1); 

'SOLUTION  CF  NCNSINGULAR  LIMEAI   ZQUATICNS ' ) ; 

'DETERMINANT  OF  REAL  MATRIX1); 

'INVERSE  OF  REAL  'IATRIX'); 

•EDITING  AXE  DISPLAY  CF  INPUT  MATRICES'); 


I  ">  T  n"*  ^^  TO'  ■  ""   ST  ,  ^  "^   i"7  J~  IT   i   T    "*   r  ^T-T  ■'■fTirr;  '  ^ 


'QUIT')  ; 
:  5  ,  'SELECT  ONE  :  '  )' ; 


END 
ELSE 

f\  T^  !"•  TT»m    •  

jELEl  i     i  =     j tj T C n  iR(OKi3£<i)  ; 
C  L  ij  t*.  R .,  C  R  iii  Li  I  ; 
IF    SELECT='Q'     THEN 
ELGIN 

PROMPTAT(10,  'DO  YOU  .JANT  TO  ERASE  THE  CDITEE  MATEI 
IF  YES  THEN 

QUITFLAG  :=  TRUE;' 
CLEARSCREEN; 
END 
ELSE 

01 
TTRPQR; 
TTRM7"  .; 


1  ->.  I 


PF  EAXS; 
MATRIXIC; 


' G' :  HELP; 
END; 


UNTIL  QUITFLAG; 
END.  (*  MATRIX  *) 


(*  VERSION  0239  * 
MODULE  CRTLI3; 


TYPE  CRTCOMMAND  =  (ERA3E0S , ERASEOL , UP , DOWN , RIGHT , LEFT , LEAD 


c?f^^rpc     Drnrpr     ^"^irnnM     D^T7Tr\^vr?     -i:^p>'-^m     t 
C  L.  v-'  Lj  '._.«K  ,  »  v,  ^  i_i  ^  i  v  ,      Cj  «  1  iJ  U  u  t  ft  Zi  V  1  U '    -  c  ,  -  . .  i  tj  r«  0 1 1  ,  i. 

3L]  IKON, 

slink  jff)  ; 
3ETOFCHAR  =  SET  OF  CHAR; 
PTE  =  "INTEGER; 

CPMOPERATION  =  (C0LD3CG.T , WARM300T , C  )NSTAT,  ZONIN ,CONCUT 

PUUCUT,RDRIlJ,HOME,SELDSK,SETTFK,3ETSEC 
DSKREAD,DSKWRITE) ; 
COLOR  =  ( BLACK, 3LUE, GREEN, CYAN, RED, MAGENTA, BROWN, LGRAY 

LGREEM,LCYAM,LRED,LMAGENTA, YELLOW, WHITE) ; 
STRING40  =  STRING  [40]   ; 


N,TT  IE 


,  :td  !. 

r»o  7  v   1 


3ELL  = 
BSP  =  G; 

CRTINFO:  ARRAY [CRTCCMMAMD]  OF  CHAR; 
CCLORINFO:  ARRAY [COLOR]  OF  INTEGER; 
PREFIXED:  ARRAY [CRTCOMMAND]  OF  300LEAN; 
DDOSVAL:  INTEGER;   (*  GLOBAL  VAEIADLE  FO: 


EXTERNAL  FUNCTION  23DCS3  5  (-FUNC  :  INTEGER  ;  PARM:PTR):  I 


PROCEDURE  3IOSCALL (  FUNG : CPMOPERAT I  ON ; CCH : INTEGER)  ; 

VA.R  DESCRIPT:  ARRAY  [1..  5]  OF  BYTE; 
T3ITE:  3YTE; 
J:  INTEGER: 


GIN  (*  3IOSCALL  *) 
IF  FUNC=CONOUT  THEN 
BEGIN 

T3ITE  :=  OCR; 

CLRBIT (T3ITE,8)  ; 

DESCRIPT [1]  :=  4; 

DESCRIPT[2]  :=  TBITE; 

DESCRIPT [2]  :=  '  ' ; 

DESCRIPT [4]  :=  '  ' ; 

DESCRIPT [5]   :=  ' 

BDCSVAL  :=  0BDOS86 ( 5C ,ADDR (DESCRIPT [ 1]  ))  ; 

IF  FT  IC  =  CC*TIN  THEN 
3EGIN 

DEECRIPT[1]  :=  2; 

TOR  J: =2  TO  5  DO 

DESCRIPT  [J]  :=  '  '  ; 


3D0SVAL  :=  QBD0S8 6 ( 50 , ADDR (DESCRI PT  [  1 ]  )  )  ; 
END; 
END;   (*  3I0SCALL  *) 


:etinit; 
; r  ofcrt:  crtcc  imand; 

3R 


egim  (*  crtinit  *) 

::t:  ;fo  [leac  lu]    : 


:hp  (2 
'  J'  ; 


_  i  a  i  . 

.  —  tot 


q'; 


r 
_  i 


ul\i  1  -  J  i.  v  [  ...  i  .  ti  ._  i_.  U  O  j 

CRTINFO [EEASECL]  :=  ' 
CRT INFO [RIGHT]  :=  ' C 
CRTINFO [LEFT]  ■=  'n1- 
CRT  INFO [UP]  : 
CRTINFO [DOWN]  := 
CRTINFO [TIME]  := 
CRTINFO [FCCLOR]   : 
CRTINFO [BCCLOR]  : 
CRTINFO [REVIDON] 
CRTINFO [REVIDCFF] 
CRTINFO [INTENON] 
CRTINFO [IMTENCFF] 
EPTINF0[3LINK0N] 
CRTINFO  [BLINKOFF] 
PREFIXED [LEADIN]  :=  TALSE 
PREFIXED [ERASEOS]   :=  TRUE 
PREFIXED [ERA3ECL]   :=  TRUE 
PREFIXED [ RIGHT]  : =  TRUE; 
PREFIXED [LEFT] 
PREFIXED [UP]  := 
PREFIXED [DCRR] 
PREFIXED [TINE]  := 
FOR  OPCRT:=FCOLOR 
PREFIXED [OPCRT] 
END;   (*  CRTINIT  *) 


i  i-  i 


=     :?  JE; 
TRUE; 
=    T  R  U  E  ; 
=    FziLb E ; 

TO    BLINKOFF    DO 

:=    TRUE; 


PROCEDURE  CRT (C : CRT COMMAND) ; 
BEGIN  (*  CRT  *) 

IF  PREFIXED [C]  THEN 


END; 


BIOSCALL (CONCUT,ORD (CRTINFO [LEADIN] 
BICSCALL (CONOUT,ORD (CRTINFO [C] ) ) ; 
*  CRT  *) 


p 

RECEDE 

RE  GOTOXY (X, Y: IN 

1  LL 

ER 

V 

AR  I 

l 

T  '  1  ^  r  ^  ^  n  ■ 
1  J  i  I^'jijK  i 

t) 

EGIN 

(*  GOTOXY  * 

) 

FOR 

I 

:=1  TO  IOC 

DO; 

CRT 

(L 

EADIN)  ; 

FOR 

I 

:=1  TO  IOC 

DC  ; 

3  I  C 

~c 

ALL (CONOUT, 

CRD  (  ' 

Y') 

)  ; 

FOR 

I 

:=1  TO  100 

DO  • 

3C 

ALE (CONOUT, 

Y  +  3  2  ) 

/ 

FOR 

I 

:=1  TO  ICO 

i_>C  ; 

BIOSCALL (CCNOUT, X+32) ; 
SBLASTX  :=  X; 

SBLAETY  :=  Y; 
FOR  I:=l  TO  ICO  DO; 
END;  (*  GOTOXY  *) 


-?<CCEBNr:E  PROMPTS T  (Y:  INTEGER;  S:  STRING)  ; 
VAR  J:  INTEGER; 
3EGIN  ( *  PROMPT AT  * ) 

GCTCXY(CY)  ; 

JEITE(S)  ; 

CRT (ERASEOL) ; 

FOR  J:=l  TO  4  DO 
CRT (TIME)  ; 
END;   (*  PROMPTAT  *) 

L  sOOijuUi'.t     ^ ■  J_j  Li.n.\.t-  -~  K  Jli  j_j  I .  , 

v 7 7>  p       T  .        Tnnr'TD  ■ 

j    .  i  •.'.         J     •  iU    1    LlO^lV    ; 

-  '.  m  i  f  13  .1  c  v  c  Q  >    ■ 

i   (,  L  l< .i  -  _> L  o  /    , 

FOP  J:=l  TO  4  DO 
CRT (TIKE)  ; 
END;  (*  CLEARSCREEN  *) 

PROCEDURE  CLEARIT  (I -.INTEGER)  ; 

VAR  J:  INTEGER; 
BEGIN  (*  CLEARIT  *) 

f-r  mpyv  r  r      T  V  • 
jV>  iV,AI    ^  v.    ,   I  )     r 

^  1\  i    ^  a_i  i  .  i-i  O  u,  v>  ■  J  J     , 

rr r> p      t  .  —  i       rn p      ,1      no. 

-  ^  I  v         U     •    —  X  i   O  "3  W  O 

CRT (TIMS) ; 
END;      (*    CLEARIT    *) 


FUNCTION  GETCHAR (ONSET : GETOFCHAR) :  CHAR; 
VAR  CM:  CHAR; 

OCH:  INTEGER; 
.CCD:  BOOLEAN; 
BEGIN  (*  GETCHAR  *) 
REPEAT 

2I03CALL (CCMIU, 0) ;  (*  0  ] 
CH  :=  CNR (EDOSVAL) ; 
OCH  :=  ORE (CH) ; 
IF  OCH>96  THEN 
IF  OCH<123  THEN 

CH  :=  CNR (OCH-32)  ; 
GOOD  :=  CH  IN  CKSET; 
IF  :JCT  GOOD  THEN 

NRITE (CHR (7) ) 
ELEE 

IF  CH  IN  ['   '  .  .  *  ]  '  1  TIN 
NRITE(CH) ; 
UNTIL  GOOD; 
oETCHAR  ; =  CH  ; 


A  DUMMY  VARIABLE  *) 


END;     (*    GETCHAR    *) 


PROCEDURE    GET3TRING (VAR    3:     STRING;    MAXLEN:     INTEGER); 
VAR    SI:    STRING [1] ; 

STEMP:     STRING; 

OKSET:     SET    CF    CHAR;    • 
BEGIN     (*     3STSTRINC    *) 

^r/Crrp        •   -         r    '         >  111]. 

C  "]  ■  —        '  '    • 

i-"  it  r  ■  1  o       •  —       II. 
j  i  £.nr      •  -  ^ 

REPEAT 

IE    LENGTH (STEMP)     =    0    THEN 

Sl[l]      :=    GETCHAP (OKSET     ) 

ELSE 

IF    LENGTH (STEMP) =MAXLEN    THEN 

Sl[l]     :=    GETCHAR ( [CHR(RTN) ,CHR( 

BSP) ] ) 

ELSE 

SI  [I]      :=    GETCHAR (OKSET    +     [CHR (RTN) , CHR (BSP) ] ) ; 

IF    SI  [1]     IN    OKSET    THEN 

STEMP     :=    C0NCAT(STEM?,S1) 

ELSE 

IF    31  [1] =CHR(BSP)     THEN 

BEGIN 

CRT (LEFT)  ; 

'T?  T  mTji   /   I         I    \     . 
fprp    i  r   T?  r?  i?  \    . 


UNTIL    Si  [1]     =    CHR(RTN)  ; 

IF    LENGTH (STEMP)     <>     0    THEN 

S     :=    STEMP 
ELSE 

WRITE  (S)  ; 
END;     (*     3ETSTRING    *) 


BOOLEAN; 
3EGIN     (*    YES    *) 

E  ES     : =    GETCHA R (  [ ' Y '  , ' N ' ]  )      IN     [  ' Y ' ]  ; 


END;     (*    Y 


*    vr  ^    * 


PROCEDURE    WAIT; 
3 EG IN     (*    WAIT    *) 

CLEAT  IT (3)  ; 

PROMPTAT (10 , ' PLEASE    WAIT. . . 
END;      (*    WAIT    *) 


')  ; 


PROCEDURE     NHEAB ( A: STRING) ; 
VAR    I:     INTEGER; 
BEGIN     (*     rJHEAD    *) 

CLEARSCRESN ; 

I     :=     (80-LEN 3TII (A) )     EIV    2; 


GCTCXY  (1,0)  ; 
WRITELN(A)  ; 
GCTCXY (1,1)  ; 

FOR  I:=l  TO  LENGTH (A)  DC 
IF  A  [I]  =  '  '  then 
S7RITEC  ') 

IT  r    C  77 
L  Li  O  Hi 

•  Ki  J.  M      -      /    , 
NRITELN; 

end;  (*v?he;  d*) 

procedure   imtread(var  k: integer); 
type  stf.ing6  =  string[6j; 

VAR  3 :  STRING6 ; 

PROCEDURE  GETISTRING(VAR  3 : STRINGS ; MAXLEN : INTEGER) ; 
VAR  51:  STRING [1] ; 

STEMP, TTEMP:  STRINGS; 

OKSET,OKAY3ET:  SET  OF  CHAR; 

FLAG1,FLAG2,NFLAG:  DCOLEAN; 

./L,.:.....,ii,i-,ij,^,l..   i-.i-.^i.i'v, 

PECCEDUFE  CHECXINT; 

v  \ j. .  i  .  IN  iLvjLKJ 
BEGIN  (*    CHECKINT    *) 

TTEMP  :=  STEMP* 

I  J  ELAN  2  THEN 

DELETE  (TTEMP, 1,1)  ; 

IF  LENGTH (TTEMP) <5  THEM 

Tr  -  "1   .  —   rp  a  r  O  IT 


BEGIN 

T1! 


T2 
T  ^ 

T4 

rs 


=  CRD  (TTEMP [1]  ) 
=  CRD  (TTEMP [2]  ) 
=  CRD (TTEMP [3] ) 
=  ORD (TTEMP [4]  ) 
=  CRD (TTEMP [5] ) 
IF  Tl<=51  THEN 
IF  Tl=51  THEN 
IF  T2<=50  THEM 
IF  T2=50  THEN 
IF  T3<=5  5  THEN 
IF  T3=55  THEN 
IF  T4<=54  THEN 
IF  T4=54  THEM 
BEGIN 


IF  LIFLAG  THEN 
BEGIN 

IF  T5<=56  THEN 

FLAC1  :=  FALSE 
ELSE 

F  L  A  G  1  '.  —    T  R  \J  S 
END 
ELSE 
BEGIN 


IF  T5<=55  THEM 

FLAG1  :=  FALSE 
ELSE 


Ejl-ilJ 


flagi 


J-         ■       '       U»J      J-l 


=  TRUE 

=  FALSE 

=  TRUE 

=  FALSE 

=  TRUE 

=  FALSE 

=  T  R  U  E  ; 


ELSE 
FLAG1 

ELSE 

FLAG1 
ELSE 

FLAG1 
ELSE 

FLAG1 
ELSE 

FLA  Gl 
ELSE 

FLI  21 
EL  5E 

fl;  gi 

END; 
IF  FLAG1=TRUE  THEM 
BEGIN 

FLAGI  :=  TRUE; 

L  :  =  LENGTH (STEM?)  ; 

FOR  I:=l  TO  L  DC 

CRT (LEFT) ; 
TCP.  I:=l  TO  L  DO 

'JRITE  (  '  '  )  ; 
FCR  l:=l  TC  L  EC 

CRT  (LEFT)  ; 
FOR  I:=l  TC  L  DO 
WRITE  (CHR(BELL)  )  } 
T?Mn  • 

END; (*  CHECKINT  *) 


:EGIN(*  GETISTRIMG  *) 
.-  EPEAT 

OKSET  :=  [ ' 0'  . .  ' 9'  ]  ; 
SI  :=  '  '  ; 
STEMP  :=  '  '  ; 
LIFLAG  :=  FALSE; 
CEP EAT 

IF  LEUGTH  (STE.1P)  =  C  THEN 
BEGIN 

MAX  :=  MAXLEM-1; 
FLAG 2  :=  FALSE; 
0KAY3ET  :=  )KSET+ [ '+' , '■ 
SI  [  1]  : =  GETCHAR ( OKAYSE' 
IF  Sl[l]  IN  (['+' ,'-']) 
BEGIN 

IF  CI [!]='_'  THEN 
NFLAG  :=  FALSE; 


)  ; 

THEN 
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MAX  :=  MAX+1; 

FLAG 2  :=  TRUE; 
END; 
END 
ELSE 

IF  LENGTH (STEMP) =MAX  ["HEN 

S  1  i  j_  J   :  =  GtiT-^n AR  (  [ Cl  r>  (  ^1   )  /  Cri J 
(3SF) ] ) 

'  L  O  ij 

3 EG  I  N 

IF  (LENGTH  (STE -IP)  =1)   AND  FLAG2 
THEN 

51 [1]  :=  GETCHAR(OKSET+ [CHR(BSP) ] ) 
GLJZ 

Sl[l]  :=  GETCHAR(OKSET  +  [CHR (RTN) , GHR 
END; 
IF  Sl[l]  IN  (OKSET+[,+* , '-'] )   THEN 
b  i  L A P   I  —  Llj^^i  [olLrlr /Oi 

) 


31?) ]) ; 


1  [I] =CHE (BSP)  TH]  u 


CRT (LEFT) ; 
NRITEC  ') 


CRT (LEFT) ; 

DELETE (STEHP, LENGTH (STEM?) ,1) ; 


UNTIL  Si  [1]  =  CHR  (RTN)  ; 

CHECKINT; 
UNTIL  MCT  FLAG1; 
S  :=  STEMP; 


it  m  rs  •  t  * 


T I STR I NG  * ) 


PROCEDURE  STRTGINT(VAR  S:3TRING5;VAR  K:INTEGEFN; 
CONST  Z  =  48; 
VAR  STEM?:  STRING5; 
FLAGP:  BOOLEAN; 


I, 


3EGIN(*  3TRT0INT  *) 
STEMP  :=  3; 
IF  STEMP [1] ='-'  THEN 
ii  L  AG  F  •  =  -  A  L  o  E 

_.  J-i  O  ill 

FLAG?  :=  TRUE; 
IF  (NOT  FLAGP)  CR  (STEMP [ 1 ]='+' )  THEN 

DELETE (STEMP, 1,1) ; 
L  :  =  LENGTH (STEMP)  ; 
K  :=  0; 
FOE  I:=l  TO  L  DO 

K  :=  10*X+CRD(STEMP[I] )-Z; 

It      Cui'ior-JfiLijIj      L  .  i  Ci  in 

K    :  =    -  K  ; 

END;  (*     STRTGINT    *) 
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3EGIN(*  INTREAD  *) 
GETISTRING(3,6)  ; 
STRTOINT  (3,K)  ; 

end;  (*  ::jtre?d  *) 


fi  icticn  value (var  s:strimg;  vae 

1ST 


iER) 


LIMIT  =  1.0E+1S; 


*~7  — 


*  > 


V.  R  A,Y:  REAL; 

NEG,NEGEXP,GTL:  BOOLEAN; 

DIGITS:  SET  OF  CHAR; 

FUNCTION  POWRTEN (EX : INTEGER) 
vAR  I  :  INTri'iiiR; 

BEGIN  (*  PC'/JRTEN  *) 

.   r\   m 

.  —      U  i 

m         •    _        -]  r\    . 

l        •  i,  •  v;  , 

i  v !_,  L~  u    . '  x 

TT?        ~,  P  D    f  r>  «  \         rp  ri  t7  M 


A  3  E    I    OF 

=    T*1.0E1; 


/ 

3 
END; 


=    T*1.CE2; 
=    T*1.CE4; 

=    T*1.GE£; 

—  x         iiUblJ, 
=       rp*  "I         rj-7-5  9  • 

~"  X  U_      •      '  J    — i    ~i     t-     f 

=    T*1.0E64; 

=       T  *  -1        API   TC. 

-  ixl. JlZDo; 


ex    :=   en  div   2 

I  :=  1+1; 
:;  itil  ex=0; 
pcwrten  :=  t; 

END;  (*  P0/7RTEN  *) 

3EGIM  (*  VALUE  *) 
I  :=  1; 
P  :=  C; 

P  ?   •  =  r  • 

CTL  :=  FALSE; 


IGI 


0  '  .  .  •  9 


REAL; 


S  : =  CONCAT (Sf  ' % ' )  ;  ( *  SAFETY  CHARACTER  * ) 

A  :  =  0  ; 

E  :  =  0 ; 

NEG  :  =  (S[I]=«-') ; 

./MILE  S  [  I  ]  =  '   '  DC 

I  :=  1+1; 
IE  (S[I]='+')  OR  SEC  THEN 

I  :=  1+1; 
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WHILE  S[I]  III  DIGITS  DO 
BEGIN 

IF  S[I]='0'  THEN 

P2  :=  P2+1 
ELSE 
B  E  G I  N 

?    :=    P+P2+1;      • 

p  n   .  _  r\  . 

L  *■        •      '  '  / 

j  lb   .  —   1  i\  U  ili  , 

END; 
IE  A<LIHIT  THEN 

A  :=  10*A+ORD (S[I] ) -Z 

ELSE 

E  :=  E+l; 
I     :=    1+1; 

END; 
IF  S  [I] ='  .  '  THEM 

P    :  =    P  +  P  2 ; 
I  :=  1+1; 

IF  NOT  (3 [I]  IN 

insert  re;  ,S,I)  ; 

I  :  =  I  + 1 ; 


VJH  ILL  S[I]  =  '0*  DO 
6 EG  I  H 

P2  :=  P2+1; 
IF  2KLIHIT  THEN 
BEGIN 

A  :=  10*A+ORD (S  [I] ) -Z; 

L-i  m    *~    j_i    X  / 

END; 
I     :  =    I  + 1 ; 

END; 

j.  <-    J  ^  L    in  Jj  .  i 

?    :=    P+P2; 
WHILE  3 [I]  IN  DIGITS  EC 
BEGIN 

?  :=  P+l; 
IF  A<LIMIT  THEN 
BEGIN 

A  :=  L0*A+ORD (S  [I] ) -Z; 
E  :=  E-l; 

end; 

I  :=  1+1; 

END  * 
IF  3  [I]  IN  ['E»  , 'E' ]  THEN 
BEGIN 

I  ■  =  I  +i  • 

J  :  =  0  ; 

NEGEXP  :=  (3[I]='-')  ; 

IF  (S  [!]  =  '  +  ')  CE  NEGEXP  THEN 
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I  :  =  I  + 1  ; 
WHILE  3 [I]  IN  DIGITS  DO 
BEGIN 

IF  J<LIMIT  THEN 

J  :=  10*J+ORD (S  [I]  ) -Z; 
I  :=  1+1; 
END; 

if    iegexp  then 

else 

E  :=  S  +  J; 


Y  :=  A; 

IF  NEG  THEM 

Y  :  =  ■*  Y ; 
IF  E<C  THEN  % 

VALUE  :=  Y/POWRTEN(-E) 

ELSE 

IF  EOG  THEN 
VALUE  := 

I       !rvJHl\i  Liu  \£i)  » 

7?  r    '.  ;  T? 

VALUE  :=  Y; 
IE  ((EOT  NEE)  AND  (Y=0.0))  THEN 
VALUE  :=  -Y; 

jutt  p  ^  r  t  i  —  i   i  p,r 

T    .  _    T  '  1  . 

E  :=  DOPY (3,1, LENGTH (S) -I) ; 

END;  (*  VALUE  *) 

PROCEDURE  3ETEEAL(V.AR  S  :  STRING ;  MAXLEN  :  INTEGER)  ; 
VAR  El,  32:  STRING  [1] ; 

STEMP:  STRING  [80]  ; 

INTSET,ALP3ET,SIGSET,0KSET,MISCSET:  SET  OF  CHAR; 

LOC:  INTEGER; 

KAR,CHCICE,NTOER:  INTEGER; 

EEEFLAG,EXPELAG:  BOOLEAN; 
BEGIN   (*  GETREAL  *) 


=  f  '  A 


=  ['  +  ',  '-'  ] 

1   T-1  |       |       | 


ALPSET 

3IG3ET 
\  I S  C  S  E  T  :  = 

EXFE 

EVE: IP  :=  '  »  ; 

SI  :=  '  '  ; 

l-/  —        / 
PERFLAG  :=  FALSE; 
EAR  :=  0; 
REPEAT 

LCC  :=  LENGTH (STEMP) ; 
IF  LENGTH (STEMP) =0  THEN 
BEGIN 

CE3ET  :=   IISCSST+INTSET+SIG3ET; 
31  [1]   :=  GETC'IAR  (CK3ET+ [CHE  (ETN)  ]  )  ; 
END 
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ELSE 

IF  LENGTH (STEMP) =MAXLEN  THEN 
BEGIN 

CKSET  :=  [CHF.  (RTN)  ]  ; 

Sl[l]     :=    GSTCHAR(OKSET+[CHR(BSP) 

ELSE 
3EGIN 

IE   iiOT   enpflag  then 

BEGIN 

LOG  :=  LENGTH  (STE.1F)  ; 
S2 [1]  :=  STEMP [LOC] ; 
IE  S2[l]  IN  SIGSET  THEN 
CHOICE  :=  1 

T7  r  C  TT 

IF  32 [1]  IN  INTSET  THEN 
CHOICE  :=  2 
ELSE 

IE    S 2  [  1 1  =  '  .  '     THEN 


] )  ; 


.1         ^  ^  wll^l^L 


P  '.'  C  T7  r-T 
•  M  V  r"1  pm 


—  I  T  Q^Cr^  J.  T^lT'Ci.'Tl    . 

—  '  T    ;?  f  CV  T1  -L   T  "  "  r*1  C7  T?  rp  _l_    T 

—  MbtoiiitlHioijiT  [ 


CHE  (F 
CHR(I 


TN)  ]  ; 

T1  N"  "\  1  • 


IND; 


END 


BEGIN 

LOG  :=  LENGTH (STEMP) ; 

32 [1]  :=  STEMP  :LOC]  ; 

IE  12 [1]  IN  3IGSET  THEN 

CHOICE  :=  1 
ELSE 

IE  32 [1]  IN  INTSET  THEN 
CHOICE  :=  2 
ELSE 

IE  S2[1]='E'  THEN 
CHOICE  :=  3; 
CASE  CHOICE  OF 


1:  OKSET 
2:  OKSET 
2:  OKSET 


=  INTSET; 

=  INT3ET+ [CHR  (ETH 

=  S I GSET+ INTSET ; 


ZED; 

31 [1]   :=  GETCHAR(OKSET+[CHR(BSP) ] ) 

run  • 

i_.  l*  U  i 

IF  Sl[l]  IN  (OKSET- [CUR (RTN) ] )  THEN 
BEGIN 

3TE  IP  :=  CONCAT (STEMP, SI) ; 
IE  S1[1]=,E1  THEN 

BEGIN 

NISCSET  :=  MISCSET- [ ' E * ] ; 

BED 
ELSE 


15 


IF  SI  [1]  =  '  .  '  THEN 
BEGIN 

PERFLAG  :=  TRUE; 
MISCSET  :=  MISCSET-['.' 
END; 
END 
'LGE 

IF  SI [ 1] =CHR (BSP)  THEN 

O  ill  o  1  i:i 

LOG  :=  LENGTH (STEM?) ; 
IF  STEIiP  [LOG]  =  '  .  '  THEN 
PERFLAG  :=  FALSE 

ELSE 

IF  STEM? [LOG] = ' E1  THEN 
EXPFLAG  :=  FALSE; 
CRT (LEFT)  ; 
,7RITE(  '  ■  )  ; 
CRT (LEFT) ; 
DELETE  (STE,'I?,LCC,  I)   ; 


IF  MOT  EXPFLAG  THEN 

:IISCSET  :=  MISC3ET+  [  '  E'  ]  ; 
IF  NOT  PERFLAG  THEN 

MISCSET  :=  1IECCET  + ['.']; 
UNTIL  SI  [1] =CHR (RTN)  ;  > 
IF  LENGTH (5TEMP) <>0  THEN 
RESIN 

NTOER  :=  23-LENGTH (S) ; 
IF  NTGER>0  THEN 

ivEITE  (  '  '  :  NTOER)  ; 

HMD  • 
END;   (*  SET REAL  *) 

PROCEDURE  SPACEBAR; 

VAR  SH:  CHAR; 

REGIE  (*  SPACEBAR  *) 

.  /  R I T  E  L 1 1 ; 

WRITE ('PRESS  SPACERAR  '); 

CH  :=  GETCHAR ( [ '  • ] ) ; 

WEITELN; 
END;   (*  SPACEBAR  *) 

(*  THE  FOLLOWING  ROUTINES  ARE  FOR  SOLOR  MONITORS  *) 


(*  PROCEDURE  INITCOLOR; 
VAR  SHADE: COLOR; 

i  !  If]  i  LulK  J 

:rr:  m 
i  •  =o  • 

FSR  SHADE:=3LACK  TC  WHIT 
BEGIN 

SCLORINFC [SHADEj  :=I ; 
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I :  =  I  + 1 ; 
END; 

EMD;  *) 

(*  PROCEDURE  ALTCOLCR (C:COLOR)  ; 
VAR  J: INTEGER; 
BEGIN 

--  R  i  _>v^C  LioR )  ; 

FOR  J:=l  TO  IOC  DO; 

IICSCALL  (CONGUT,CCLCRINFC  [C]  )  ; 

FOR    J:=l    TC    ICO    DO; 
END;     *) 

(*  PROCEDURE  PAINT (X, Y /WIDTH , DEPTH : INTEGER; SHADE : COLOR 
VAR  J: INTEGER; 
3EGIN 

GCriOXY(X^Y)  ; 

ALTCOLCR (SHADE) ; 

FOR  J:=l  TO  DEPTH  DO 

O  Li  Vj  1   J 

>7rite  (  '    '  :widtii)  ; 
gotcxy (x,y+j) ; 
end; 

FOR    J:=l    TO    IOC    DO; 

e;:d;    *) 

l    IV.-   ^J  ±_i  L  .  1~/   m 
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(*    VERSION    0286    *) 

MODULE    OVERLAY].; 

(*    MODULE    LINSYS       *) 

TYPE    DOMAIN1    =    1.  .20; 

'..".TRIM    =    ARRAY  [DCMAINl ,DCMAIN1 ]     OF    REAL; 
LIETI    =    ARRAY  [DOMAI-Nl]     CF    INTEGER; 
LISTR    =    ARRAY [DCMAINl]     CF     REAL; 

EXTERNAL    PROCEDURE    SPACEBAR; 

PROCEDURE    RLUD(ND/N: INTEGER ;VAR    KER: INTEGER; VAR    ALU : MATRIX; VAR    JN 

LISTI;VAR    SCALE :LI3TR) ; 

VAR     I, IND,IP1,IC, J,K,NN:     INTEGER; 
B IG , EL , PIVOT , ROWNRM ,  T :     REAL ; 
CH:    CMAR; 


F JNCTION    OMAN I (A,3:REAL 
BEGIN     (*    AMAXi     *) 
IF    A<3    THEN 
AMAXI     :=    3 

& MAY!    •  —   A  - 

END;     (*    AMAXI    *) 


i  *  "iQ    * 


RLUI 


...J 

COMPUTE    SCALE  [I]  =1 . C/INFIMITY    NORM    CF    RONf  [  I  ]     CF 
FOR     I:=l    TO    NN    DC 


RONNRM    :=    0.0; 

^  <~  o         T.    "1         rn,-^        n-\t        0^> 

lOK       J^-i        lO       HlJ        U'J 

ROWNRM    :=    AMAXI  (ROWNRM,  A3S  (ALU  [  I ,  J] )  )  ; 

IF    ROWNRM=0.0    THEN 

RONNRM     :=     1.0; 
SCALE [I]     :=    1.0/ROWKRM; 


(*     LU    DECOMPOSITION    BY    GAUSSIAN    ELIMTNATICN.        L    MAS    UNIT    B 
(*     EXPLICIT    RON    INTERCHANGE    WITH     IMPLICIT    EQUILIBRATION     IS 
IS     :=    1; 

FOR     I:=l    TO    NN    DO 
BEGIN 

NRITE( '...'); 
IND     :=    I; 
IF     IONN    THEN 
BEGIN 

BIG    : =    0.0; 
FOR    K:=I     TO    NN    DC 
BEGIN 

T     :=    SCALE[K]*A3S(ALU[K,I] ) ; 
IF    T>BIG    THEN 
BEGIN 

IND     :=    K; 


j  p.'jC.  .: i  L 
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BIG    : =    T ; 
END; 
END; 
IF    3IGO0.0    THEN 

3  EG  IN 

IF  IIJDOI  THEN 

FOR  J:=I  TC  HN  DC 
E2EGIN 

T  :=  M,U[IND,J]  ; 
ALU [IND,J]   :=  ALU  [I, J]  ; 
ALU [I, J]   :=  T; 
END; 
3CALE [ IND]   :=  SCALE  [I]  ; 
13  : =  -IS; 
END; 
IP1  :=  1+1; 
PIVOT  :=  ALU  [1,1]  ; 
FOR  K:=IP1  TC  NM  DC 
3EGIM 

EL  :=  -ALU [K, I] /PIVOT; 
ALU[K,I]   :=  -EL; 
IF  ELOC.C  THEN 

FOR  J:=IP1  TC  NN  DC 

ALU[K,J]      :=    ALU[K,J]+EL*ALU[.I,J]  ; 

U  L  >  U    , 

END; 
.IF    ALU  [I,  I]=0.0    THEM 

IS    :=    0; 
JN  [  I  ]     :  =    IIiD ; 

j::[U:i]     :=    IS; 
KER    :=    C; 
END;      (*     RLUD    *) 

PROCEDURE    RFBS (ND,N: INTLGER;VAK    KER: INTEGER ;VAE    ALU:MATRI 

LISTI ;VAR    XrLISTR) ; 


•/  •  T7?\  p        T 

-  i     J 


VAR     I,K,KP1,L,LP1,N;U,NN:     INT) 
Z:     REAL; 

CM:    CHAD; 


BEGIN        (*    RFBS 


*      r>  -7"-  c      * 


IF    JN[NN]=0    THEN 
BEGIN 

v  ■*?  t?        •  —       1  • 
r    -, ..      .  —      „  , 

I7RITELN; 

WRITELN('IN  RF35,  THE  TRIANGULAR  FACTOR  U  OF  ?> 


) 


WRITELNC  IS  SINGULAR.  A  UNIQUE  SOLUTION  DOES  '); 
ITELNC 

SPACEBAR; 


OTrpr-'rM/l  •  t  ^~  m  ^  V  T  C  T1  '     \      • 


ti  a  i  i  ; 

v  pd      •  =      r\  • 
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NMl  :=  NN-1; 
IF  NM1O0  THEN 
BEGIN 
(*  SOLVE  LY=3  (FORWARD  SUBSTITUTION)  *) 
FOR  L:=l  TO  NMl  !")C 
3EGIN 

nix  x  x  j-i  \   ...   /  , 

v     .  —   t  m  r  r  i  • 

<L»    I  =   A  [A  j  J 

X[K]   :=  X[L]  ; 

X[L]  :=  Z; 

LF1  :=  L+l; 

FOR  K:=LPI  TO  NN  DC 

K[K]  :=  X[K]-ALU[K,L]*Z; 
END; 
(*  SOLVE  UX=Y  (BACKWARD  SUBSTITUTION)  *) 
FOR  I:=l  TO  NMl  DO 
3  EG  IN 

ivKl  llj  (   ...   )    , 

K  :=  NF-I; 

K?l  :=  K+l; 

X[KP1]      :=    X[KP1]/ALU[KP1,KP1] ; 

Z    :=    -X[KP1] ; 

FOR    L: =1    TC     K    DO 

X[L]      :=    X[L] +ALU [L,XF1] *Z; 


„.  .„ 


v  r  n 

^  I  x 


1]/  &LU[1,1 


ND;        (*    RFB3    *  ) 


:DEND. 


20 


(*  VERSION  02  8  5  *) 
MODULE  OVERLAY3; 

CONST  MAXDE5  =  20; 
MAXDEGP1=21; 

TYPE  DCMAINl  =  1.  .  2C; 

DOMR?l  =  l.  .MAXDSGFl; 
L,ISTRPl=AERAY[DOME?l]   )F  REAL; 
MATRIX  =  ARRAY [DOMAINl , DOMAIN1 ]  CF  R 
LISTI  =  \RRAY  [DOMAINl]  CF  INTEGER; 
LIETR  =  ARRAY [DOMAINl]  CF  REAL; 
CRTCOMMAND  =  | [EEASEOS  ,  E-RASECL  ,  UP  ,  DCvv1 

FCOLOR/BCOLOR,REVIDON , 

BLIMKON, 

SLINKOFF) ; 
CHAR; 


.L; 


RE 


RIGHT, 
VIDOFF 


,1 


T,LE2 :: 

TENON, 


INTENOFF, 


SETOFCHAR  =  SET  CI 

PTR  =  "INTEGER; 

ZPMOPERATICN    =     (C0LD300T , WARMBCCT , CCi 

PUNOUT,RDRIM,HGME,3E3 
D5KREAD,DSK  IRITE) ; 

3TRING4C    =    STRING [40] ; 

STRINGS    =    STRING  [6]  ; 

STRINGS C    =    STRING  [SO]; 


'  V   C  TT  i  T 

i  K  ,  b  b  J. 


,CCMCU 
,3ET3  . 


r ,  l  i 


'dm  a 


vAR  ACIFLAG,IC3FLAG:  EXTERNAL  BOOLEAN; 

IOM,  IGNDIM,RGWDIMB:  EXTERNAL  INTEGER; 
ICTA,TVEC:  EXTERNAL  MATRIX; 
IOTB,XX:  EXTERNAL  1ATRIX; 

i-v  f  iliVK/  liiVl  «      ti\i  IRttAL      Li  1  o  ...  , 
GSDET:     EXTERNAL    REAL; 

(*  EXTERNAL  PROCEDURES  AND  FUNCTIONS  *) 

EXTERNAL  PROCEDURE  CFTINIT; 

EXTERNAL  PROCEDURE  CRT (C : CRTCOMMAND) ; 

EXTERNAL  PROCEDURE  GOTOXY (X , Y : INTEGER) ; 

EXTERNAL  PROCEDURE  PROMPTAT ( Y : INTEGER ; S : STRING) ; 

EXTERNAL  PROCEDURE  CLEARSCREEN: 

EXTERNAL  PROCEDURE  CLEARIT ( I : INTEGER) ; 

EXTERNAL  FUNCTION  GETCHAR (OKSET : SETOFCHAR) :  CHAR; 

EXTERNAL  PROCEDURE  GETSTRING ( VAR  S : STRI NC; MAXLEN : 

EXTERNAL  FUNCTION  YES:  BOOLEAN; 

EXTERNAL  PROCEDURE  vvAIT; 


INTEGER) ; 
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EXTERNAL  PROCEDURE  WHEAD; 

EXTERNAL  PROCEDURE  INTREAD (VAR  K: INTEGER); 

EXTERNAL  FUNCTION  VALUE (VAR  S:STEING;  VAR  FrINTEGEE):  REAL; 

r v m t? p r.i a x  nnnrrTiiRP     nr^RFST   n^Q     c  •  cj hp p  t  •  if;  •  M a  v r  rii .  t  »jrn r?r; tt n  \  . 

EXTERNAL  PFCCEDURE  SPACE3AR; 


PROCEDURE  GETCOLUMN  (MROW,  J:  INTEGER;VAR  A:MATRIX); 
VAR  II,K,LL,P4:  INTEGER; 

5REEL:  STRING; 
FLAG:  BOOLEAN; 


PRCCEDUr^  CCLDISPLAY; 
VAR  IC:  INTEGER; 


N  (*  COLD 

r  ?\  r  t  -'  (  o  >  . 


'LAY 


GOTCXY (0,2) ; 
FOR  IC:=1  TO  NEON  DO 
BEGIN 

K  :=  IC+1; 

GOTCXY (0,K) ; 

GOTCXY (9,X) ; 

-  ~r  7  mr?  r  ■?   r  if      t  i  \    . 
« '-    I  L£>  \r\\  L\~  tvi  \  )   , 

p>.Tr>  • 

PRCMPTAT (23, ' IS  THIS  CCRRECT?  Y/N  ' ); 
CD;  (*  C0LDI3FLAY  *) 

BEGIN  (*.  GETCOLUMN  *) 

FLAG  :=  FALSE; 
REPEAT 

CLEAR IT (2) ; 
CCLDISPLAY; 
IF  NOT  YES  THEN 
BEGIN 

PROMPTAT (23 , ' IF  NO  CHANGE  -  PREEN  RETURN  '); 
FOR  LL:=1  TO  MROW  DC 
BEGIN 

K  :=  LL+1; 

GOTCXY (9,K) ; 

IF  A[LL, J] >=0  THEN 

WRITE  (  '  ' )  ; 
SREEL  :=  ' ' ; 
GETREAL (SREEL, 21) ; 
IF  LENGTH (SREEL) >0  THEN 

A[LL,J]  :=  VALUE (SREEL, P4  )  ; 
END; 
END 


ELSE 


TRUE; 
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UNTIL  FLAG; 
END;  (*  GETCOLUMN  *) 

PROCEDURE  GETPOLCOF(K-ROW:  INTEGER ;VAR  L:LISTRP1)  ; 
VAR  I,J,NEWI,NRODIV2,P4:  INTEGER; 

SEEEL:  STRING; 
FLAG:  BOOLEAN; 

ROCED'JRE  CCLDISPLAY; 
VAR  I:  INTEGER; 
3EGIN  (*  CCLDISPLAY  *) 
CLEAR IT (2)  ; 
GOTOXY (0, 2) ; 
NRODIV2  :=  NROW  DIV  2; 
FOR  I:=l  TO  MRODIV2  DO 
3 EG  IN 

GOTOXY (0,2*1)  ; 
WFITG ( 'CCEF  CF  X' ) ; 
CFT(U?)  ; 
WF  ITE  (NEOW-I)  ; 
CRT (DOWN) ; 
WRITE (  '  =  ')  ; 
CCTOXY (12,2*1)  ; 
WRITE(L  [I]  )  ; 
END; 
FOR  I:=NRODIV2+l  TO  NROW  EG 

e  e  g  : : ! 

newi  :=  i-nrcdiv2; 
gctoxy  (4  0,2*newi)  ; 

E  C 


« i  L 

r*  r»  m 


mE ( 'CCEF  EE  X' ) ; 
iUP)  ; 


WRITE (NROW- I) ; 
CRT (DOWN) ; 
WRITE ('=' )  ; 
GOTOXY (5 2, .2* NEWI)  ; 

WRITE (L  [I]  )  ; 

PEDHPTAT(23, ' IS  THIS  CORRECT?  Y/ 
END;   (*  COLDISPLAY  *) 


)  ; 


BEGIN  (*  GETPCLCCF  *) 
FLAG  :=  FALSE; 
REPEAT 

CLEAR IT (2) ; 
CCLDISPLAY; 
IF  NOT  YEE  THEN 
EEC  IN 

PRCMPTAT(23, ' IF  NO  CHANGE  -  PRESS  RETURN  '); 
FOR  I:=l  TO  NRODIV2  DC 
BEGIN 

GOTOXY (12,2*1)  : 
IF  L[I] >=C  THEM 

WRITE  (  '   '  )  ; 
EREEL  :=  '  '  ; 
GETREAL (EREEL, 22)  ; 
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IF  LENGTH (SREEL) <>0  THEN 
L[I]  :=  VALUE(SREEL,P4) ; 
END; 
FCR  I:=NR0DIV2+1  TC  MROW  DO 
BEGIN 

NEW I  :=  I-NRCDIV2; 
GOTCXY  (  "5:,2*-v:E.;I)  ; 
IF  L  [I]  >  =  Q  TH 
WRITE  (  '  '  )  ; 

ctjppr   •  —   '  i  • 

GETREAL (SR£EL,21) ; 
IF  LENGTH (SREEL) <>0  THEM 
L[I]  :=  VALUE (SREEL, P4) ; 

END; 


v  n  n 

ELSE 
FT.  A 


=    TRUE; 


U.<i   lu       "  b/Aj  , 
Lj  i  J  LJ  f        \  j  t,  i  t  <j '  Li  L.  '-•  j 


PFOCSDURE    PMEN (I : INTEGER ;C:CHAR;S: STRING) ; 
EEGIN     (*     PMEN    *) 

2-OTOXY (C , I) ; 

NFITELN (C: : , '     ' :3,S) ; 
tIEII    *) 


2ND;     (* 


PROCEDURE  HEAD(A:3TRING; J: INTEGER) ; 
VAR  I:  INTEGER; 
BEGIN  (*  HEAD  *) 

I  :=  (CO-LENGTH (A) )  DIV  2; 

GOTOXY (I , J) ; 

WRITELN (A) ; 
END;  (*  HEAD  *) 


PROCEDURE  MATF IXIC; 
VAR  QUITFLAG:  BOOLEAN; 

CHOICE:    CIAR; 


PROCEDURE  EDIT; 
VAR  EDQUIT:  2CCLE:.:-; 
EDCHOICE:    CHAR; 

PROCEDURE  AENTSR(A0R3:CHAR) ; 
VAR  I,J,COLDIM,RO",7DIM:  INTEGER; 

'1ANAME:  STRING  [3]  ; 
BEGIN  (*  AENTER  *) 
ELEARIT (1) ; 
EASE  ACRE  OF 
'  A  '  :  3  E  G I '  I 

AC  I  FLAG  :=  TRUE; 
REPEAT 
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PROMPTAT  (2,  '  ENTER  DIMENSION  OF  SQUARE  MATRI 

INTREAD (ICNDIM) ; 
UNTIL  ((IONDIM>0)  AND  (  ICMD IM< 2 1 )  )  ; 
RCWDIM    :=    ICNDIM; 
COLDIM  :=  ICNDIM; 
MANAME: = ' A1 ; 
?  f-  •  n  • 
i  g i  •  BEGIN 

IOEFLAG  :=  TRUE; 
REPEAT 

PRC  1PTAT  (2,  '  ENTER  EC  J  DIMENSION 

INTREAD (ROWQIMB) ; 
UNTIL  ((ROWDIM3>0)  AND  (ROWDIMB<2 1 ) ) ; 
REPEAT 

CLEAR  IT (1)  ; 

PROMPTAT (2, 'ENTER  THE  COLUMN  DIM  OF 

INTREAD (I  CM)  ; 
UNTIL  ((IOM>0)  AND  (IOM<21)); 
COLDIM  :=  1 0.1; 
ROWDIM  :=  RCWDIMB; 

i  '  ■  t  r,   m  r  •  -  I  n  I  • 


)  ; 


'  TT   ~>   O    I 


)  ; 


')  ; 


FOR  I  :  =  I  TO  EC  WD  I M  D  0 
NCR  J:=l  TO  COLDIM  D( 


1  A'  :  IOTA [I , J]  :=  j.O; 
•B1 :  ICTB  [  I , J]  : =  0.0; 


ZOO* 

BEGIN 

CLEAR IT (1) ; 

NEITELN (' ENTER  COLUMN  '  ,J,'  OF  MATRIX  ', MANAME); 

CASE  A0R3  OF 

'A' :  GETCOLUMN(ROWDIM, J,IOTA) ; 
' 3' :  GETCOLUMN (ROWDIM, J, ICTB) ; 
END; 
END; 
OLEARIT(l) ; 
END;  (*  AENTER  *) 


PROCEDURE  AEDIT(AORB:  CHAR); 
VAR  ACHOICE:  CHAR; 

AQUIT,EFLAG:  BOOLEAN; 

I,J,COLDIM,ROWDIM:  INTEGER; 

IANAME:  STRING [3] ; 


3  EG  IN  (*  A  EC  IT  *) 

' A ' :  BEGIN 

OFLAC 
MAN AN E 
R ONE  i:i 


"a  r-  t  c  r  7\  <^  • 
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COLDIM  :=  IONDIM; 
END; 
'3' :  BEGIN 

EFLAG  :=  ICBFLAG; 
MANAME 


RCT7DIM 
COLDIM 
END; 


=  RCWDIMB; 
=•  IOM; 


\enter (acr3) 

:lse 

5EGIN 

ACUIT  :=  FALSE; 
REPEAT 

CLEARIT( 1) ; 


L'i  fc.  Li  {  Z.  f       \      ,      &  l>  i  i      ^  u  K  i .  jl,  . ,  i      ilAliUA         J    , 


EOTGXY(2,8) ; 
NRITE(  '  SELECT  ONE  :  *  )  ; 
OKSET  :=  [';,',  'B  ','  Q  ']  ; 
ACHOICE  :=  GETCHAK (OKSET) ; 
CASE  ACHOICE  OF 

'  a  '  •  pn  i:  =  "  TO  CCL""7'-1  EC 

begin 

CLEAR  IT (1)  ; 

INRITELLH 'ENTER  COLUMN  '  ,1,'  Or 

CASE  ACRE  OF 

'  A'  :    C-ETCCLUMN  (RO'NDIM,  I ,  IOTZ 
' B ' :    GETCOLUMN (ROWDIM, I , ICT 
END; 
END; 
■B1 :    BEGIN 

CLEARIT(l) ; 

GOTOXY(C ,2) ; 

.JRITS('DC     YOU    iJANT    TO    ERASE    CUF; 

V?    Y/N     ' ) ; 
CRT (ERASECL) ; 

FOB  l:=l  TO  ICC  DO  CRT (TIME); 
IF  YES  THEN 

AENTER (AOBB) ; 
ENE  ; 
AOUIT  :=  TRUE; 


In   i  A  1  A 


0)  ; 


i  r  ' 

v. 

ENE; 


UNTIL    AQUIT; 
END; 
END;     v*    AEDIT    *) 


T  M      I 


I  * 


:di' 


) 


'LEAR .Id-  EE  i ; 


IiE\D (  'MATRIX     EDITOR1  ,C)  ; 
EDCUIT     :=    FALSE; 
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REPEAT 

CLEARIT(l) ; 

PMEN(2, 'A' , 'EDIT  MATRIX  A'); 

PMEN  (4  ,  'B'  ,  'EDIT  MATRIX  E'); 

PMEN (6,  ' Q1 , 'QUIT'  )  ; 

GOTOXY  (2,3)  ; 

".'PITS  (  '  SELECT  ONE  •:  '  )  ; 

ni't"7T   •—   ri^i   i  -?  i   i   •  i  • 

L  t>-  o  iu  i   .  -   l     i     ~     i     —     \  i 

EDCHCICE  :=  SETCHAR (CKSET) ; 

^ A i3 ili   ^i>  ^ji^Illj  UD 

1  A1  :  AEDIT  (  • A1  )  ; 
'3'  :  AEDIT ( 'B' )  ; 
'  Q1  :  EDQUIT  :=  TRUE; 


UNTIL  EDQUIT; 
END;  (*  EEIT  *) 


PROCEDURE  DISPLAY; 
VAE  DISQCJIT:  BOOLEAN; 
DISCHOICS:  CHAR; 

PROCEDURE  DDICPLA(AORE:CHAR) ; 
VAE  I, J,COLDIM,RCUDIM:  INTEGER; 

CH:  CHAR; 

CELAG:  BOOLEAN; 

MANAME:  STEINS [3] ; 
3EGIN  (*  DDISPLA  *) 
CLEAR  IT (1)  ; 

•A1:  SEE  I II 

MANAME 


_  i^i 


=  IONDIM; 
=  IONDIM; 


B' 


ECWOIM 
END; 
BEGIN 

CELAG  :=  ICE  SLAG; 

M7  NAME 


CCLDIM 

ECEEIM 
E.4D; 


—    •  T3  I 


ICM; 
RCWDIME; 


IE  NOT  CELAG  THEN 
BEG  IE 

GOTOXY  (0,  3)  ; 

,;RITE  (  '  THET-E  IS  MO  MATRIX  ', MANAME,'  YET  '); 

CRT (ERASEOL) ; 

FOR  I:=l  TO  100  DO  CET(TIME); 

SPACEBAR; 
EED 

BEGIN 

.7RITELM(  'THE  COLUMNS  3F  MATRIX  ', MANAME,1  AR 
ECR  J:=l  TC  COLD  I H  DC 
REGIE 


'  ) 
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WR I TELN ( 'COLUMN  ',J,'  OF  ' ,MANAME,'  IS  :'); 

FOR  I:=l  TO  ROWDIM  DO 
BEGIN 

WRITE (MANAME,  '  [ '  , I ,  '  , '  , J  ,  ' ] = ' )  ; 
CASS  A0R3  OE 

' A1 :  WRITELN ( IOTA [I , J] ) ; 
'3'  :  WRITELN (ICTE [I.J])  ; 
END; 
END; 

SPACEBAR; 
E  N  D ; 
END; 
END;  (*  DDISPLA  *) 

PROCEDURE  HCCPY (AORBrCHAE)  ; 
VAR  CH:  CHAR; 

CFLAG:  BOOLEAN; 
MANAME:  STRING  [3]  ; 
CNUM,I:  INTEGER; 
3  EG  IN  (*  HCCPY  *) 
EASE  A0R3  OF 
■A' :  BEGIN 

CFLAG  :=  AOIFLAG; 
MANAME  : =  ' A ' ; 
CNU' '.    '  =    3  ; 

,  _  ,  m     ,  _.  n  _  , 

<J  .    L>  I_i  O  1  I  ■! 

CFLAG  :=  IOEELA  :; 
1ANAME  :=  ' 3' ; 
ENUN  :=  4; 
END; 
ZED; 

CLEAR IT ( 1) ; 
IE  NOT  CFLAG  THEN 
BEGIN 

GCTOXY(0,3) ; 

WRITE ( 'THERE  IS  NO  MATRIX  '/MANAME,'  YET  '); 

CRT (ERASEOL) ; 

FOR  I:=l  TO  100  DO  CRT (TIME); 

SPACEBAR; 

ELSE 

HARDCOPY (CNUM) ; 
END;  (*  HCOPY  *) 

BEGIN  (*  DISPLAY  *) 
DISQUIT  :=  FALSE; 
REPEAT 

CLEARSCREEN; 

HEAD  (  '  :\I  TRIX    DISPLAY',0); 

"mpm  /  o      i  a  i      i  cpcppM     r,  t  c r> r  :.  v     op     i  '  ^   • 

t  .  I  Li  Li  \  £.  /       ;•.       f       O '^  t\  Lj  sU i.i      'J  i  Dr  Ln  I       '^L        rt       /; 

P4EN (4 , 'B1, 'SCREEN  DISPLAY  CF    3'); 
PMEN(5, 'C , 'HARDCOPY  OUTPUT  OF  A'); 
PMEN ( 8, 'D' , 'HARDCOPY  OUTPUT  OF  3  '  )  ; 
PMEN(1C, ' Q' , 'QUIT' ) ; 
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GOTCXY (2,12)  ; 
WRITE ( "SELECT  CHE  :  '  )  ; 
CKSET  :=  [ 'A' . . ' D'  , '  Q' ]  ; 
DISCHCICE  :=  GETCHAR (OKSET) ; 
CASE  DISCHCICE  CF 

A' :  DDISPLA ( ' A1 ) ; 
EDI  -FLA  (  '  31*)  ; 

hcofy  ('■:'); 

d i sou it  :=  true; 

until  disquit; 
ehd;  (*  display  *) 

begin  (*  1atrixio  *) 
clearscreen; 
quitflag  :=  falge; 

REPEAT 

CLEARSCREEN;   . 

tj.'\ U  {      1  . .  -   J  i        l,     iXlA   i.  /  L  r  U  J  , 

r:iEM  (2,  '  A1  ,   '  EDIT   IATRICES'); 

PMEN  (4,  '3'  ,  'SCREEN  OR  HARDCOPY  OUTPUT'); 

PMEN (6, 'Q' , 'QUIT' ) ; 

GOTCXY  (2,8)  ; 

WRITE  (  ' SELECT  CUE  :  '  )  ; 

p  r-  •-  t-i  m    ._    r  I  -•>,  1    I  T3  I    I  O  1  1  ■ 
L  . .  J>  U  1    .  -   L   *  -   /   -   /    -   J  / 

CHOICE  :=  GETCHAR (CKSET) ; 
CASE  CHOICE  OE 

' A' :  EDIT; 

'3' :  DISPLAY; 

'Q* :  QUITFLAG  :  =  TRUE; 


UNTIL  QUITFLAG; 

END;  (*  MATRIX 10  *) 


PROCEDURE  HARDCOPY (HNUM: INTEGER) ; 
VAR  F:  TEXT; 
■   CH:  CHAR; 

PRFLAG:  BOOLEAN; 

RESULT:  INTEGER; 

PROCEDURE  SSTPRINT; 
VAR  CH:  CHAR; 

FTRIES:  INTEGER; 


SETPRINT  *) 


BEGIN  (* 

PRFLAG  :=  FALSE; 
FTRIES  :=  0; 
REPEAT 

ASSIST (F,  *  EST:  '  )  ; 
REWRITE (F) ; 
IF  IORESULT=255  THEE 
BEGIN 

ETRIES  :=  FTRIES+1; 
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IF  FTRIES<=2  THEN 
BEGIN 

NRITELN(  '  PUT  PRINTER  ON  LINE  '); 
SPACEBAR; 
END; 
END 


'KL'  Li  H  O 


:  =  r  R  0  E 


UNTIL  PRFLAG  3E  (FTRIES>2); 
ID;  (*  GETPRINT  *) 


PROCEDURE  PRSAXB; 

VAR  I, J:  INTEGER; 
3E3IN  (*  PRSAXB  *) 

FOR  J:=l  TO  ION  DC 
BEGIN 

WETTELN (F) ; 

NRITELN  (F,  'THE  SOLUTION  JOE  COLUMN  '  ,J,'  IS 
FOR  I:=l  TO  I0NDI.1  DC 
BEGIN 

.  1  :<  1  i  H  Li  .i  (  E   ,        |        ,  A  A  [  1  ,  J  J    j       j        )    , 

END; 
END  ; 


jl  ;     \ 


*      DPC1YP      * 


IS  A  A  r      *  ) 


PROCEDURE  PRMATRIX (AOR3:CHAR) ; 
VAT  DIM, I, J:  INTEGER; 

KIMJ      IT?.  C"^  <-    T  \;r"    [    ~    ^     • 

.  ijA    .'  r..  1  L-i  •       u  i  uliJO   [  ..  j    / 

2sgim(*  prmatrix  *) 
:aee  acrb  of 


lRIX     '  ,MANAME,  '     ARE:     '  )  ; 


NANA;  IE  :  =     '  A'  ; 

DIN    :=  IONDIM; 
END; 
' D' :     BEGIN 

MANAME  :=     'D' ; 

DIN     : =  ION; 

HjLi'J  } 
Li  _*  ly  j 

,'AITELN  (F)  ; 

r,7RITELN(F,  'THE    COLUMNS    OF    . 
NRITELN (F) ; 
FOR    J: =1    TO    DIM    DO 
3EGIN 

.vRITELN  (F)  ; 

JRITELN(F, 'COLUMN  ' ,J,'  OF  ', NANAME, *  IE  :'); 
CASE  A0R3  OF 

•A':  FOR  I:=l  TO  IONDIM  DC 

V7RITELN  (F  ,  «  A  [  '  ,  I ,  '  ,  '  ,  J  ,  '  ]  =  '  ,  IOTA  [  I  ,  J]  )  ; 
'3':  FOR  I:=l  TO  ~::DI1E  DO 

NRITELN(F, ' E [ ' , I , ' , ' , J , ' ] = * , I0T3 [ I , J ] ) ; 
END; 

END;   (*  PRMATRIX  *) 
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PROCEDURE  PRRNAA; 
VAR  I, J:  INTEGER; 
BEGIN  (*  PPRNAA  *) 

tfRITE-LN  (F)  ; 

NRITELN(F, 'THE    ARRAY    OF    COMPLEX    EIGENVALUES     IS'); 

NRITELN  (F)  ; 

FOR     I : =1    TC     IOMDI   I    DC 

■;i:t"17-  ■]/>;      <    r  '      m  ■:•  -  r  r    f  t  1       •       '      T" ^ \7T  T  T  1       MM* 

-■^TrpT7r»'/T7\     . 


•n  xz>v  r 


NRITELN  (F,  'THE 
tfRITELN (F) ; 

T    .  _    1  . 
J    .  -    x    , 

REPEAT 

IF  TEVI  [J]  OO.O  THEN 

BEGIN 

nriteln  (F)  ; 

1-7RITELN  (F,  '  VECTOR  '  ,  J  ,  '  I 
FOR  I:=l  TC  IONDIM  DC 


X  EIGENVECTORS  ARE  ' ) ; 


,<  i\  i.  i  __  ^  j.  .  */  i_  _,  x  ^  .   ,  j  ,   [  ,  .  ,     j  -   ,  i  i/Du  [  i  ,u  j  ;  , 

"•pT'T"?r  m  /^   i   i   rp u pf-i  r  j   Til  l   l  ]  I  \  . 


END; 
WRITELK (F)  ; 

NRITELN(F,  'VECTOR  ' ,J+1,'  HAS  COMPONENTS  '); 
FOR  I :=1  TO  IONDIM  EC 
BEGIN 

,vRIxE(F,  Vi-,LTCs  f  J  +  l,   [   ,1,   j-[   ,  x  v  i_,C  [  I  ,  J  J  )  , 
.,.,1  x  hLN  (  r  ,   ,  ,  -  i  V-.L  [  1  ,  J  +  l  J  ,  j   )  - 

r  '  1  •"•>  • 
-J  -1 ._-  , 

tti  •.  i  r^. 

ELSE 
BEGIN 

NRITELN(F) ; 

WRITELN(F, 'VECTOR  '  ,  J  ,  '  HAS  COMPONENTS  '); 

FOR  I  :  =1  TO  IONDIM  CC 

EEC  IE 

.JKxii.  l£  ,   V-v_xw-\   ,J,   [   ,  1  .   J  -  [   ,  1  V  i-t  t  1  ,  J  J  ,'  , 

r,7RITELN(F,  '  ,  '  ,  C  .  C,  ' ]  ' )  ; 
END; 
J  :  =  J  + 1 ; 

r-1  ^  -  •">  » 

1_J  Li   LS      f 

UNTIL  J> IONDIM; 

END;   (*  PPRNAA  *) 

PROCEDURE    PRRDET; 
BEGIN     (*     PRRDET    *) 

JRITELN (F) ; 

..'EITELN  (F ,  'THE  DETERMINANT  OF  MATRIX  A  IS-  '  , 
ERD;   (*  PRRDERT  *) 


SET PR I NT; 

IF  PRFLAG  TEEN 
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BEGIN 

CASE  H.NUM  OF 
PRRNAA; 
PRSAXB; 

PPM ATE  IX ('A')  ; 
PRriATRIX  (  '3'  )  ; 
5:  PREDET; 

p:;o; 

fT    >ci7   '  ci     d  rr  <^  fir  m  \    • 

'  m  n  • 


StlD;      (*    HARDi 


MOD END. 
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(*  VERSION  0235  *) 
MODULE  OVERLAYS; 


(*  EIGENHQR   IODU 


nnr.r  * 


TYE  E  DC  IP.  INI  =  1.  .20; 

MATRIX  =  ARRAY [DOMAINl ,DCMA INI]  OF 
LICTI  =  ARRAY [DOMAINl]  OF  INTEGER; 
LISTR  =  ARRAY [DOMAINl]  OF  REAL; 

EXTERNAL  PROCEDURE  SPACEBAR; 


EAL 


PROCEDURE  HQR2 (NM,N,LOW, IGH: INTEGER; VAR  H:MATRIX;VAR 

VAR  Z:MATRIX;VAR  I  ERR: INTEGER)  ; 

CONST  MACHEP  =  1.0E-14; 

V.aR  EN  i  E  I  -  '■  2  /  I  ,  1 1  ,  i  T  S  ,  J  ,  I ' ,  L  , .  i ,  i  ?  2  f  N  A  :  INTEGER; 

NORM, P,Q,R,RA,S,SA,T, TEMPI, TEMP2,VR, VI, W,X,Y,ZR,Z 
FLAG1,FLAG2, FLAGS, FLAG4 ,NCTLAS ,TESTEXIT :  BOOLEAN; 
CH:  CHAR; 

FUNCTION  SIGN(E,F:REAL) :  REAL; 
BEGIN  (*  SIGN  *) 

IF  F<C  THEM 

SIGN  :=  -A3S(E) 

rr   r 

SIGN  :=  ABS (E) ; 
E:tD;  (*  SIGN  *) 

FUNCTION  'UNO (I 1,12: INTEGER) :  INTEGER; 

BEGIN  (*  NINO  *) 
IF  IKI2  THEM 
MING  : =  II 

:jlcc 

MING  :=  12; 
END;  (*  MI  NO  *) 

PROCEDURE  CCMDIV ( XR , XI , YR , YI : F EAL ; VAR  ZR , Z I : REAL ) ; 
VAR  D,:i:     REAL; 
EEC  IN  (*  DOMDIV  *) 

IF  A3S(YR)<AES(YI)  THEN 
BEGIN 

H  :=  YR/YI; 

D  :=  YI+H*YR; 

ZR  :=  (XR*H+XI)/D; 

ZI  :=  (XI*H-XR)/D; 

ELSE 


NF ,WI :LISTR 


1  ,  Li  L    .  K  Li  i  .  Li 


BEGIN 

D  :=  YR+H*YI; 
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ZR  :=  (XR+H*XI)/D; 
Zl  :=  (XI-H*XR)/D; 
END ; 
END;  (*  COMDIV  *) 


PROCEDURE  HQROFTl; 
VAR  I:  INTEGER; 

PROCEDURE  LOOK; 
VAR  I:  INTEGER; 
BEGIN (*  LOOK  *) 

A    :=  CUM 2+1; 

F  L  A  G  2  l—    FALSE; 

REPEAT 

M  :=  M-l; 

ZZ  :=  H[M,M] ; 


—    i\—   Lj  U 


=     (R*S-VJ)/H[M+1,M]+H[M,M+1]  ; 
=  H[  I+1,M+1]-ZZ-R-S; 


TEMP  2 

t::  !P2 


=  A3S(P)+A3S(Q)+A3S(R) ; 
=  P/3; 
=  2/S; 
=  R/S; 

IE  M*L  THEN 

FLAG  2  :=  TRUE 
ELSE 
3EGIN 

•=  AB3(H[M,M-1])*  (A3S(Q)+A3S(R)  )  ; 
=  ABS (H [M-l, M-l] ) +ABS (ZZ) +ABS (H [M+1,M+1 
=  [-1ACHEP*AES  (F)  *TEMP2; 
IF  TEMPI  <=  TEMP2  THEN 
C  LAbz  I  =   i  KUxLi  ; 

vJRITEC  .  M  ; 
J  N  T I L  lLA'jz^iaJ^j 
MP  2  :=  .1  +  2; 
FOR  I:=MP2  TC  EN  DC 
3  EG  IN 

LI  [1, 1-2]  :=  O.C; 
IF  IOMP2  THEN 
H  [  I ,  I - 3 ]  : =  0.0; 

i-j  Li  U  , 

ID;  (*  LOOK  *) 


PROCEDURE  DOUBLEQR; 
VAR  K:  INTEGER; 

PRCGECURE  COLMCD; 
VAR  I:  INTEGER; 
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BEGIN  (*  COLMOD  *) 
FOR  I:=l  TO  J  DO 
BEGIN 

P  :=  X*H [I,K] +Y*H [I,K+1] ; 
I?  NOTLAS  THZ'lI 
BEGIN 

F  :=  ?  +  Z-Z*:i  [I  ,K+2]  ; 
N[I,K+2]  :=  H[IrK+2]-P*R; 
end; 

:i[I,K+l]   :=  H[I,K+1]-F*Q; 
H[I,K]  :=  H[I,K]-P; 
END; 
END;  (*  CCLMOD  *) 

PROCEDURE  ROWMCD; 
VAR  J:  INTEGER; 
3EGIN  (*  ROWMOD  *) 

for  J:=K  to  :;  do 

E  EG  1 N 

?  :=  H[K,J]+Q*H[K+1,J]  ; 
IF  NOTLAS  THEN 
BEGIN 

P  :=  P+R*H [K+2, J] ; 
H[K+2,J]  :=  H[K+2,J]-P*ZZ; 
END; 
H[K+1,J]   :=  H [K+l, J]~P*Y; 
:![;-, J]  :=  H[K,J]-F*X; 

,jl,u  r 

END;  (*  ROWMOD  *) 


PROCEDURE  ACCTRANS; 
VAR  I:  INTEGER; 
BEGIN (*  ACCTRANS  *) 
FOR  I:=LOW  TO  IGH  DO 
BEGIN 

P  :  =  X* Z  [  I ,  K]  +  Y* Z  [  I ,  K+ 1  ]  ; 
IF  NOTE; 5  THEN 
BEGIN 

P  :=  P+ZZ*Z [I, K+2] ; 
Z[I,K+2]  :=  Z [I,K+2]-P*R; 
END; 
Z[I,K+1]  :=  Z  [  I f K+l] -P*Q; 
Z  [  I ,  K  ]  :  =  Z  [  I ,  K  ]  -  P ; 
END; 
END; (*  ACCTRANS  *) 

BEGIN (*  DOUBLEQR  *) 
FOR  K:=M  TC  NA  DC 
BEGIN 

ELAEl  :=  FALSE; 
NOTLAS  :=  KONA; 
IF  KOM  THEN 
BEGIN 

?  :=  H[K,K-1] ; 
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Q  :=  H [K+l, K-l] ; 

R  :  =  0.0; 

IF  NOTLAS  THEN 

R  :=  H[K+2,K-1] ; 
X  :=  ABS(P) +ABS(Q)+ABS (R) ; 
IF  X=0.0  THEN 

?LAG1  : =  TRUE 
ELSE 

3EGIN 

=  P/X; 


=  Q/X; 
=  R/X; 


R 

end; 

END; 
IF  FLAG1=FAL5E  THEN1 
BEGIN 

S  :=  P*P+Q*Q+R*R; 
3  :=  SQRT(S) ; 
3  :=  SIGN(S,P) ; 
IE  K=  1  THEN 
BEGIN 

IF  LOT  THEN 

H[K,K-1]   :=  -H[K,K-1] 
END 


rr  q 


f  :  =  f-r  o  ; 
X  : =  F/S ; 
Y  :=  Q/S; 
^  Z  i =  R/S  J 

Q  :=  Q/P; 

?.  :=  R/P; 

ROUMOD; 

WRITE ( ' . ' ) ; 

J  :=  NINO (EN,K+3)  ; 

EOL.10D; 

,vr.  i  ih(   .   J  , 

ACCTRANS; 

;RITE  (  '  .  '  )  ; 

!ND; 


END; (*  D0U3LEQR  *) 


BEGIN  (*  HQROPT1  *) 

TEETEXIT  :=  FALSE; 
IF  ITS>=100  THEN 
BEGIN 

I  ERR  :=  EN'; 

WRITELN('THE  ITERATION  LIMIT  OF  100  HAG 

WRITELNC     REACHED  IN  -NCR-'); 

3FACE3AR; 

TESTEXIT  :=  TRUE; 


;en  '  )  ; 


t.i; 


:r< 


BEGIN 
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IF  (ITSOO)  AND  (ITS  :1CD  10  =  0)  THEN 
BEGIN 

T  :=  T+X; 

FOR  I:=LOW  TO  EN  DC 

H[I,I]     :=    H[I,I]-X; 
3     :=    ABS (H [EN,NA] ) +ABE (H [NA,ENM2 

.  =     n     7  5*s  ** 
"    :  =    X ; 

,j  :=  -0.4375*S*S; 
END; 
IT3  :=  ITS+1; 
LOOK; 
DCUBLEQR; 

END; (*  HQROPT1  *) 

PROCEDURE  HQROPT2; 

PROCEDURE  I OWMCD2; 
VAR  J:  INTEGER; 

2EGIN(*  RO-:7MCD2  *) 
FOR  J:=NA  TO  N  DC 
BEGIN 

ZZ  :=  N[NA, J] ; 

END;  (*  R03MCD2  *) 


PROCEDURE  COLMOD2; 
VAR  I:  INTEGER; 
BEGIN (*  COLMOD2  *) 
FOR  I:=l  TC  EN  DO 
BEGIN 

ZZ  :=  H[I,NA] ; 
H[I,NA]  :=  q*zz  +  p*h[i,e: 
H[I,EN]  :=  Q*H[I,EN]-P*: 
END; 
END; (*  COLMOD2  *) 


PROCEDURE  ACCTRANS2; 

VAR  I:  INTEGER; 
BEGIN  (*  ACCTRANS2  *) 
FCR  I  :=LC.J  TO  IGH  DC 
BEGIN 

ZZ  :=  Z [I ,NA] ; 

Z[I,NA]     :=    Q*ZZ+P*Z [I,EN] ; 

Z[I,EN]     :=    Q*Z [I,EN]-P*ZZ; 

BEGIN     (*    HQROPT2     *) 
?    :=     (Y-X)/2.0; 
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Q    :=    P*P+W; 
ZZ     :=    SQRT(ABS  (Q)  )  ', 
H[EN,EN]     :=    X  +  T; 
X    :=    H [EN, EN] ; 
H[NA,NA]     :=    Y+T; 
IF    Q<0.0    THEN 
BEGIN 


-  ■  -■•  i    ■      J 
V7E[EM] 

;i  [  a] 
:n  [en] 

END 


-    a+P; 

=    -  ZZ  • 


3  EG  IN 

ZZ     :=    P+SIGN (ZZ,P) ; 
WR[NA]     :=    X  +  ZZ; 
ivR[EN]     :=    WR  [NA]  ; 
IF    ZZOO.O    THEN 

i7R[EN]     :=    X-W/ZZ; 
'.71  [NA]     :=    0.3; 
.1  [EN]     :  =    0.0; 
■"•'     •  —     'i  rpri    MAT* 

.—       A/  i\  , 

.  —     u  u  /  is  , 

ROWMOD2; 
,/RITE(  '  .  '  )  ; 
ECLMCD2; 
NRITE  ('.'); 
ACCTRANS2; 

END; 
EM  :=  ENM2; 
IF  EN>=  LO..7  THE!] 

BEGIN 

ITS  :=  0; 

ma   •  -  y  m  _  1  • 

Li>i:-1*.   .  -   Llrt-1, 

END 
ELSE 

FLAG3  :=  TRUE; 
END; (*  HQROPT2  *) 

PROCEDURE  EIGENVECTOR; 
VAR  EN, I, J:  INTEGER; 

PROCEDURE  LOOP700; 
VAR  1 ,11, J:  INTEGER; 

TTP:  REAL; 
BEGIN  (*  LCOP70C  *) 
r»7RITE  ('.'); 

FOR  II  :  =1  TO  NA  EC 
BEGIN 

I  :=  MN-II; 

.7  :=  H[I,I]-P; 
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R  :=  H[I,EN] ; 

IF  M<  =  NA  THEN 

FOR  J:=M  TC  NA  DC 
BEGIN 

IF     (H[I,J]=0.C)     OR     (H[J,EN]=0.0) 

m  m  r-\        .  r\       f\ 

1   j.  i         .—       U.U 

—  i_i  o  *_» 

R    :=    R+TTP; 


i  H  Jl.  iM 


IF  '..7I  [I]  <C  .  0  THEN 
BEGIN 

2Z     :  =  tl ' 
5  :  =  R ;  ' 
END 
ELSE 
BEGIN 

:i    :=    I; 

IF    .  J I  [  I ] =  C . 0    THEN 
3EGIN 

P  .    _         '  T   • 

■ '  r 

j  -r    vj=n     0    '"HEN 

T     :=    MACHEP*lIORM; 

'  I   r   T       !7M  I         •—  D  /  T1  ■ 

ti  L  1  ,  £N  J      .  -    -K/  i  , 


EL. 


SGI 


=  1111,1  +  1]  ; 
=  H  [1+1,1] ; 
=    (;jr[i]-p)*(wr[I]-p)+;-7I[i] 

=  (X*S-ZZ*R)/Q; 
H[I,EN]  :=  f; 
IF  ADS (X) >ABS (ZZ)  TEEN 

H[T+1,EN]   :=  (-R-W*T)/X 
ELSE 

H[I+1,EN]   :=  (-S-Y*T)/ZZ; 


*-tt  r 


i]  ; 


T>   M  T^,  • 


END; 
END; 
ND;  (*  LC  DP70C  *) 


PROCEDURE  LCOP790; 
VAR  II, J:  INTEGER; 

PROCEDURE  LOCPNORK; 


iEGIN 


*  r.oo 


OOPWORK  *) 


X  :=  H[ 1,1+1] ; 

Y  :=  H[I  +  1,I]  ; 

VR  :=  (WR[I]-P)*(WR[I]-P)+WI[I]*V7I[I]-Q*Q; 

VI  :=  (WR[I]-P)*2.0*Q; 

IF  (VR=0.G)  AND  (VI=C.O)  THEN 

VR  :=  '1ACHSP*N0RM*  (ABS(W) +A3G(Q)  + 
ABS (X) +ADE (Y) +ABE (ZZ)  )  ; 
GOMDIV ( X*R- Z Z*  RA  +  Q*SA , X*  3- Z  Z *  SA-Q*RA , 
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VR,VI,ZR,ZI) ; 
H[I,NA]  :=  ZR; 
H[I,EN]  :=  ZI; 

IF  ABS (X) > (ABS(ZZ) +ABS(Q) )  THEN 
BEGIN 

r![I  +  l,NA]   :=  (~RA-V7*H[I,NA]+Q*H[I,EN])/X; 
H[I+1,EN]  :=  (-SA-W*H[I,EN]-C*H[I,NIA]  )/X; 


-     "     -.    T    v  1 


CCMDIV(-R-Y*H [I,NA]  ,-S-Y*H [I ,EN]  ,ZZ,Q,ZR,ZI)  ; 
H[I+1,NA]     :=    ZR; 
H[I+1,EN]     :=    ZI; 
END; 
END;     (*    LC0PV70RK    *) 

3EGIN(*    LCOP79C    *) 

:CR    1 1 : =1    TO    EMM 2    EG 
BEGIN 

I7RITEC  .  ')  ; 

T._V!ATT« 

1  •"  Ll.l-ll, 

.7    :=    H[I,I]-P; 

RA    : =    0.0; 

SA    :=    II  [  I ,  EN  ]  ; 

too      t._m     mr*     m  «,      nr 

RA     :=    T \+H [ I , J] *F [J,NAj ; 

3A     :=    SA  +  H  [I  ,  J] *H [J, EN]  ; 
rME  • 
IF    .VI  [I]  <0.0    THEN 
BEGIN 

ZZ     :=    W; 

R    :  =    RA ; 

3    :=    SA; 
END 
EL3E 

l^  1^  >_;  i  J 

M    :=    I; 

IF    NI  [I  ]  =0  .  0    THEN 
BEGIN' 

CO;  ID  I V  ( -  RA ,  -SA ,  N ,  C  i  ZR ,  Z  I )  ; 
H[I,NA]     :=    ZR; 
H[I,EN]     :=    ZI; 
END 
EL£E 

LCOPWCRK; 
END; 
END; 
END; (*  LCGP790  *) 


PROCEDURE  LCOP030; 
VAR  I,J,K:  INTEGER; 
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3EGIN(*  LCOPC30  *) 

FOR  J:=M  DOWNTO  LOrt  DO 
BEGIN 

WRITE  ('.'); 

M    :=    MINO  (J,  IGH)  ; 

?CR    I  :  =  LC'N    TC    IGII    DC 


•7  <-* 


If  •  — 


FC  R     h:  =  i_iOW     i'(J     .1     JC 


zz 


t      v  ■>  *  u  r  If      T  1  • 

l  z  r\.  j     n  L  _\  ,  >j  _  , 


Z[I,J]     :=    ZZ; 

END; 
END; 
e:;d;  (*   lc  o?c  do   *) 

PROCEDURE    PRELOOP; 
3EGIN     (*    PPELCOP    *) 
'    :=    NA; 

IF    A33 (H[EN,NA] ) >A3S (H[NA,EN] )     THEN 
3  EG  IN 

N[MA,NA]      :=    Q/H[EN,NA] ; 
H[NA,EN]     :=    -  (H  [EN  ,EN]  -P)  /H  [E<< .   JA]  ; 
END 
ELSE 
BEGIN 

COMDIV(0.0,-H[NA,EN] , H [NA , NA] -P , Q , ZR, Z I ) ; 
H[NA,NA]      :=    ZR; 

END; 
H[EN,NA]     :=    0.0; 
H[EN,EN]     :=    1.0; 

TIT  '  "  .    —         MA  _1     . 

END;     (*    PRELOOP    *) 

EGIN(*  EIGENVECTOR  *) 

K  :=  1; 

BEGIN 

FOR  J:=K  TO  N  DO 

NORN     :=    MORM+ABS (H [I , J]  )  ; 
K    :=    I; 
END ; 
IF      iCRNOO.C    THEN 
3  EG  IN 

FOR  EN:=N  DOWNTO  1  DO 
BEGIN 

P  :=  NR [EN]  ; 
Q  :=  .VI  [EN]  ; 
NA  :=  EN-1; 
IF  Q<=0.0  THEN 

.)  ^  >j  I  Ci 

-r  i-l         r>  __  O  n         m  t  t  — '  t  T 

i  r      ^  —  U  .  w      intii, 
BEGIN 

.  —    r  * 7  • 
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H[EN,EN]     :=    1.0; 
IF    UAO0    THEN 
LCOP700; 

END 
ELSE 
PEG  IN 

3r?r  r-  r.  r>  . 

j.  L        &  lJi  1  _  X  y  \j        i  .  i  —  .  ; 


^  --^  r  ,  ^U  J 
C"->I1J  > 

En 3  ; 

FOR    I:=l    TO    N    DC 

IF     (KLOW)     CE     (I>IGH)     THEN 
FOR    J:=I    TO    N    00 
Z  [  I ,  J  ]     :  =    H  [  I ,  J  ]  ; 
LOCP880; 

1_J  -  .  i>   f 

I  *       yTPpHTj    ?  p"  m  p  r^       *  \ 


BEGIN( 


r: 


DC 

BEGIN 

IF     (KLOW) 

f  \  D 

(I>IGH 

BEGIN 

■-    [I] 

:  =    H 

[i,i]; 

-■I  [I] 

:  =    0 

•  o; 

z:;o; 

—  -  ■  J  1 

~  :     :  =    IGH; 

T    :  =    0  .  C  ; 

>-i; 


IF    £M>  =  LCi7    THEN 
BEGIN 

ITS    :=    0; 

\f  7V     •  —    t?  M    "   . 

E :    12    :  = 

FLAG  2     :=    FALSE; 

REPEAT 

FLAG4     :=    FALSE; 

L    :=    EN+1; 

REPEAT 

L    :=    L-l; 


THEN 


FLAG4     :=    TRUE 
ELSE 

IF    A3S (H [L, L-l] ) <=MACHEP* (A3S (H [L-l, L-l] ) +ABS (H [L,L] 
)     THEN 
FLAG4     :=    TRUE; 
UNTIL    FLAG4=TRUE; 
X    :=    H[EM,EN] ; 
IF    LOEN    THEE 
PEG  I  N 

Y    :=    H[NA,NA] ; 

E     :=    H[EN,NA]*H[NA,EN] ; 
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IF    LONA    THEN 
BEGIN 

HQR0PT1; 

IF  TESTEXIT  THEN 
EXIT; 


END 

ELSE 

• 

; ;  r   n  Q 

PT2 ; 

END 

tt  r  ;'  t? 

r?  n-r1  t  i 

H[EN,E 

N]  : 

=  X  +  T 

/ 

,:r[en] 

:  = 

H[EN, 

e:1]  ; 

WI [EN] 

:  = 

Q  .  C  ; 

EN  :  = 

NA; 

IF  EN> 

=  LOW 

THEN 

3EGI 

N 

IT 

E  :  = 

w' »" 

NA 

:  = 

EN-1; 

EN 

=  '..'  - 

END 

E  L  o  E 

FLAG 

7   .  _ 

r 

END; 

UN 

1  1  J_i   i-  Li  ft  o  ^  , 

EI 

m  . 

END; 


tic  .• 
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(*  VERSION  02G6  *) 

MODULE  OVERLAYS; 
(*  MODULE  EIGEN3AL  *) 

m  V  T"ITT   r"1  ■"  •  1  5  T  x  '  1        —   1      "  n    • 
i  _  r  _i   uvli-il.U   —    J_  *  *  i.  U  i 

MATRIX  =  ^RF:AY[D0MAIN1,DGMAIN1]  CD  REAL; 
LI3TI  =  \ERAY [DCMAINl]  OF  INTEGER; 
LISTR  =  ARRAY [DCMAIN1]  CD  REAL; 

PROCEDURE  ELMHES  (NM,N,LO;-7,IGH:  INTEGER;VAR  A:MATRIX;VAR  INT:LISTI)  ; 
VAR  I,J,KPl,LA,M,MMl,;iPl:  INTEGER; 
X,Y:    REAL; 

BEGIN  (*  ELMHES  *) 
LA    :=    IGH-1; 
"?1    :=    LCW+1; 
if   la>=kpi  the:: 

BEGIN 

lIi  11   .—   ■  1  ~  X  / 

V   •  —   n   o  . 

A   .  —   U  .  w  , 

I     :=    M; 

FOR  J: =  1  TO  IGM  DC 
BEGIN 

IF  ABS (A[J,MM1] ) >AB3(X)  THEN 
BEGIN 

,  li\  I  i  La    (  .     )   , 

I    :=    J; 

END; 

pup. 

ill  .  .  L>  i 

INT[H]     :=    I; 
IF  TOM  THE?: 
BEGIN 

FDD  J:=MM1  TO  M  DO 
BEGIN 

Y  :=    A[I,J] ; 
A[I,J]     :=    A[M,J] ; 
A[M,J]     :=    Y; 

end; 

FDR  J:=l  TO  IGH  DC 
BEGIN 

Y  :  =    A  [  J  ,  I  ]  ; 

A [J, I]     :=    A[J,M] ; 

A[JfM]     :=    Y; 

END; 
piin  > 

IF    XOC.O    THEN 
BEGIN 

IP1     :=      1+1; 
FOR     I:=MP1    TC     I  Gil    DO 


Y 


[I/MML] ; 
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IF    YOO.O    THEN 
BEGIN 

WRITE  ('.'); 

Y    :=    Y/X; 

P.  [I,MM1]     :=    Y; 

t? ^ D        T  •  —  M      TO      *  1      HP 

•a  r 


[I, J]     :=    A[I,J]-Y*7  [M,J]  ; 
R    J:=I    TO    IGM    DC 
A[J,M]      :=    \[JfM]+Y*A[J,I] ; 


END; 


IKD; 


END; 


END; 
END; 
END;     (*    ELMHES 


PROCEDURE  ELTRAN(N  I, N , LOW, IGH : INTEGER ; A : MATRIX ; 

JN:LISTI;VAR  Z:MATRIX); 
VAR  I,J,KL,MM,MP,MP1:  INTEGER; 

BEGIN-{*  ELTRAN  *) 
FOR  I:=l  TO  N  DO 
BEGIN 

FOR  J:=l  TO  N  DO 
Z [ I , J ]  : =  3.0; 
Z[I,I]  :=  1.0; 
END  ; 
XL  :=  I.GH-LCW-1; 
IE'  KL>  =  1  THEN 


3  EG  I  N 

MP  :=  IGH-MH; 

MP1  :=  MP+1; 

FOR  I:=MP1  TO  IGH  DO 

Z[I,MP]  :=  A[I,MP-1]  ; 
I  :=  JN[MP] ; 


ERITEC  .')  ; 


END; 


IE 

1  IOMP  THEN 
BEGIN 

FOR  J:=MP  T 

0 

I  21) 

:  do 

BEGIN 

Z [MP, J] 

:  =  7 

[i, 

J]  ; 

Z [ I, J] 

; 

=  0. 

0; 

END; 

Z[I,MP]  := 

X 

.0; 

END; 

i_l  L- 

v  1  r> 

A  u 

r 

* 

ELT 

Hi 

,N  *) 

PF<  OCEDUFE    BALBAK  (NM,N,LC  J,  IGII :  INTEGER  ;  SCALE  :  LI  STR ; 

.  I :  I  N  T  E  G  E  R  ;  VA  R    Z  :  M  A  T  R I X )  ; 
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VAR  I,J,K,II:  INTEGER; 
S:  REAL; 

begin (*   3al3ak  *) 
if   igholcu  the:: 

BEGIN 

FCS  I  :=LOvv  PC  IGH  *DC 
BEGIN 

J  : =  SCALE  [  I]  ; 

Cur.  J  •  —  1  i  t>   .  1  iJL^ 

Z[I,J]  :=  Z[I,J]*S; 
3ND; 
END; 

FOR  II  :=1  TC  N  DO 

t-)  r>  -«  T  »  T 

dLj  x  M 

I  : =  II; 

IF  (KLOvJ)  GR  (I>IGH)  THEN 
3  3GIN 

IF  [<LCW  THEN 

I     :=    LG>,:-II; 
:     :=    TRU  ;c(s  ;ALE[I]  )  ; 
17    KOI    THEN 

3  eg  I  :•: 

JPITE(  '  .  '  )  ; 

:i  do 


£     :=    Z[I,J] ; 

Z  [  I ,  J  ]     :  =    Z  [  K ,  J  ]  ; 

Z[K,J]     :=    S; 


END; 


; (*    BALBAK    *) 


PROCEDURE  BALANCE (N  1,N:  INTEGER ;VAF 

VAR  SCALE :LISTR) ; 
CO  1ST  RADIX  =  2.0; 


:MATRIX;VAR  LCN, IGH: INTEGER; 


VAR  FLAGA, FLAGS, FLAGC,FLAGD,FLAG1,FL; 

I, IEXC, J,K,L,M:  INTEGER; 

CJ  "5      <■""       V       ^       D       ~  •        D  TT  ?>  r    • 


.C2,NCCCNV:     BOOLEAN; 


PROCEDURE  RC'»7SEARCH; 
BEGIN  (*  ROWSEARCH  *) 

J  :=  L+l; 

FLAGA  :=  TRUE; 

REPEAT 

J  :=  J-l; 

REPEAT 

I  :  =  I  + 1 ; 
IF  IOJ  THEN 
BEGIN 
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IF  A[J,I]  OO.O  THEN 
FLAG2  :=  TRUE; 
END; 
UNTIL  (I=L)  OR  (FLAG2  =  TRUE)  ; 
IF  NOT  FLAG2  THEN 
BEGIN 


I  EX 

2.  f  T 


=        1     ■ 
-1-  I 


bLA'Jfl      :  =     t/iLL;li 


'-  \T  Pi  . 

D  IN  U  i 


UNTIL  (J=l)  OR  (FLAGA=FAL3E) ; 
END;  (*  ROWSEARCH  *) 


PROCEDURE  COLUMNSEARCH; 
BEGIN  (*  COLUMNSEARCH  *) 
J  :=  K-l; 
FLAGS  :=  TRUE; 
REPEAT 

J  :=  J+l; 
I  :=  K-l; 
FL^Gl  :=  FALSE; 
REPEAT 

I  :  =  I  + 1 ; 
IF  IOJ  THEN 
BEGIN 

IF  \[  I,  J]  OO.O  THEN 
FLAG1  :=  TRUE; 
END; 

until  (i=l)  or  (flag1=true) ; 

if  ;;ct  flagi  the:: 

BEGIN 

1  :=  K; 
IEXC  :=  2; 
FLAG3  :=  FALSE; 
END; 
UNTIL  (J=L)  OR  (FLAGB=FALSE) ; 
END;  (*  COLUMNSEARCH  *) 


PROCEDURE  MORMREDUCTION; 
VAR  I, J:  INTEGER; 
BEGIN   (*  NORMREDUCTION  *) 
FCR  I:=K  TC  L  DC 
BEGIN 

G  :=  CO; 

FOR  J:=K  TO  L  DC 
BEGIN 

if  jo i  the;-: 

BEGIN 

C  :=  C+ABS(A[J,I] )  ; 

R  :=  R+A3S(A[I,J] ) ; 
END; 
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G    :=    R/RADIX; 
WRITE  ('.'); 
F    :=    1.0; 

S    :  =    C  +  R ; 
WHILE    C<G    DO 

g  v  C  t  \t 

F  ■-     V* 


ttb  L  .\ 


3    :=    R*RADIX; 
ivHILE    C>  =  G    DC 
BEGIN 

F    :=    F/RADIX; 
C    :=    C/B2; 
END; 
IF     (  (C+R)/F) < (0.95*S)     THEN 
BEGIN 

3    :=    1.0/F; 

SCALE  [I]     :=    :.  :ALE  [I]  *F; 

KOCONV    :=    TRUE; 

7CR    J:=r'    TC     N    DC 

A  [  I  ,  J  ]      :  =    A  i  I  ,  J  ]  *  G  ; 
FCR    J:=l    CO    L    DO 

A[J,I]     :=    A[J,I]*F; 


BID; 


END  • 
!D;     (*      :ORMI  EDUCTI 


5  b  j  i .: 

S2     : =    R7 D IX* RAD IX ; 

K    :  =    1  ; 

r      •—"'■' 
jj      .  -     .  -  , 

i.  !_i  ri  o  iJ        •-       iTrtLii^    _j  j 

NHILE    NOT    FLAGD    DO 
BEGIN 

F  L  A dB     : =    FALSE; 

^SEARCH; 
IF    BLAGA    THEN 

COLUMNS EARCH; 
IF    NOT    FLAGD    THEN 
3ECIN 
REPEAT 

SCALE [M]     :=    J; 
IF  JO.I  THEN 
BEGIN 

FOR    I:=l    TO    L    DC 
BEGIN 

F     :  =    A  [  I  ,  J  ]  ; 
A[I,J]     :=    A[I,N]  ; 
MI,B]     :=    F; 
END; 
FCR     I:=K    TC     N    DO 

p  p^i   T    .  , 

DLol  li 

F     :=    A[J,I]  ; 
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A  [J,  I]     :=    A[M,I]  ; 
A[M,I]     :=    F; 
END; 
END; 
IF     IEXC=1    THEN 

FLAGC  :=  TRUE 
ELSE 

FLAGC  :=  ^ALCE; 
I?  MOT  FLAGC  THE!] 
BEGIN 

K    :=    K+I; 

columnsearch4 

end  ; 

,-7RITE(  !  .  '  )  ; 
UNTIL  FLAGC  OR  FLAGS; 
IF  JOT  FLAGS  THEN 

3EGIM 

IF  LOl  THEN 
3SGIN 

rr  r    *i  <""  p       •—      IP  7*  r  c  P  • 
_  l_j .  .  •  j  U       .  -      -  1  -  :  j  •_;  i-j  f 

L    :=    L-l; 


FfTD  • 

u  -7  D ; 

E 

.:e 

f 

I 

-5 

EL 

—  /-t 

F 
E 

AGE    THEN 
IN 

l/K       1  .  — 1\       1  U 

SCALE [I] 

-1  -p  p  -■  rn 
1-  1"  Li  t\  i 

.  I  ^  ^-  v>     J  V          .   — 

NORMRSDUC 

r        r>  r» 

Li        \J\s 

:=    1. 

FALS 
TION; 

0; 
E ; 

*  7 

u 

NTIL    NCT    H 

OCCMV 

/ 

END 

1 

L 

OW 

'. 

=    K; 

I 

]K 

\ 

=    L; 

E 

IE 

1 

(* 

BALANCE    * 

) 

SIODEND. 


49 


(*  VERSION  02  3  5  *) 

(*  MODULE  DETER:!  *) 

MODULE  OVERLAY19; 
TYPE  DOMAIN!  =  I. .20; 


i  t   r  — ■  r     i  •■  t  r -  7   r>  r>  M  a 


-l-  J 


LI  ST  I  =  -XRRAY  [DOMAIN!]   3F  INTEGER* 
EI3TX  =  P-.RRAY  [DCMAIMl]  OF  REAL; 

VAR  IONDIM:  EXTERNAL  INTEGER; 
AOIFLAG:  EXTERNAL  BOOLEAN; 
IOTA:  EXT  EI  JAL  MATRIX; 
3SDET:  EXTERNAL  REAL; 

EXTERNAL  PROCEDURE  CLEARSCREEN; 

"yTrR?]AT,  PX'TrnrIPR  ^tta  r  :-,T"  A n  ■ 

_  . ,  i  .1  .\  .  ,1  -.  Li      iULs^iiUi!       l^Ji      b  U  U  Li  i-iri-J  , 

EXTERNAL  [2]  PROCEDURE  HARDCOPY ( HNUM : INTEGER) ; 

EXTERNAL  [1]  PROCEDURE  RLUD (ND ,N : INTEGER; VAR  KER:IX 

IATRIX; 


V  .  r  T  Cm  T  •   '7 


)  Vw  • .  i  l-i  ~ 


-  .■  j  -\  •     - .  i  -  -  j  'o  _ .  i\ ; 

-  -^.-"pr^.   rx.-.p-. 

■■'■  r  • :  •  r  jq <v  r  • 

-•  ■ .;  L  i  .    a  t,  a  l  ; 

I , J,PDEG,NT: INTEGER; 

CHOICE, SELECTION:  CHAR; 

m-'-'  /~>  t-"  TE1  •        r    t  <"•■  m  f*  . 
i  -»v>  i_«r   •       L  i  v  i  r  / 

:  n  ,t;/r:    listr; 

J.  ljL\iv  •  iiUi-  'J   —  i  .  , 

r*  *  j  •      r>  1 1  ^  t":  . 

-  -  •  •      ^'""»t-» 

(-*  r*>  T~<  r-i  t-     .         '"TPD  T  MP  • 
.  JL-ijLl  .         i_l  i  I\  1  L*\J  f 

m  2,  r  r]  •  *  '  ■*  T"1  p  T  ^ '  ■ 


PROCEDURE  RDET  (SLID,  SN  :  INTEGER  ;  VAR  EKER : INTEGER; VAR  D] 

VAR  SA:MATRIX) ; 


T: REAL; 


VAR  J:  INTEGER; 
3JN:  LI  DTI; 
uOLrtLu!     u  r r  r ; 

H.         C  r"  ""•  T  \"^  • 

.       .  ..    1    1>1.,      3   i 

EN:    CH£R; 


3E  XIX     (*     REET    *) 
SXER     :=    0; 
TRUE (EXE ,SN,SKER,Si 


c  tm     cqr>A  r  p\   . 
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DET     :=    SJN  [SN]  ; 
FOR    J:=l    TO    SN    DO 

DET     :=    DET*SA[J, J] ; 
END; (*    RDET    *) 


lJT     :  =    IC1JDIM; 

pr^Ti      r  •  =  ~\        "  ~     »,]<]■      ^p 

t  <~  p      7  •  =     1      ^  ^     M  t1     n  r> 

clearscresh; 

;-jritel:-i(  '  PLEASE    /JAIT    '  )  ; 

n  ^    7  ("i    /  '.J  m        >  ■;  rn       rp  tv-  ~?  T?        C  Pi  I?  rP        'H  A  T    T ^  ^     • 

uU^li     (.'i    i    (.11     ,    1    Adu,OUij1    ;    l.iulj]      , 

i^uurtivO^l'  Guii( 

ie  tker=c   the:: 


o .., l  L  i     ;  —     ^bLi  ; 
./RITELV; 

■  '■■--'  ■>  -  ->     \     i  - 1  i-     i  -  • ..  -  u  i     ■.!.-..     .j.     -        /  o  u  i-  i  ;  / 
.  PACEBAF ; 
7EITEE/J; 

IF    YEF    THEN 


end;    ( 

MOD END . 


1     A     L\  _V  i_l    1 
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(*  VERSION  300  *) 
(*  AX=B  MODULE  *) 
MODULE  OVERLAY20; 


TYPE  DOMAINl 

MATRIX  = 
LIGTI  = 
LISTR  = 


=  1    9  °  • 
-  j.  •  •  _  ^  i 

ARRAY [DOMAIN 1, DOMAINl]  OF  REAL 

ARRAY  [DCMAI'NI]  OF  INTEGER; 

AFRAY  [DC  ';•  INI]  CX  REAL; 


ACIFLAG,IOEXLAG:  EXTERNAL  BOOLEAN; 
IOMDIM,IOM:  EXTERNAL  INTEGER; 

EXTERNAL  FUNCTION  YEX  :  ECOLEAN; 

Ci/Vi.  r-rCi-'Ji-iij     r  rCUv^tiUU  Kij     ij  it  ftv- Li -> ft  i\  , 

L  •  s.  L  ill  i\ .  Li       r  -'.  -  '^-  j /  U  :  v  j_.      o  Li  ill ii  1\ O  l_  i.  ili  £j  t ;  / 

tjAii —       ru_i       L  —  J       rlvvuuJui'.L      i .  :^  -j  .  ^    ,  . .  _y  ^     .  .  i    .  .        jli\jV.1K    *«!*••  llniij-i'.f  '. 

•  *  a  m  p  t  y  • 

"ad       T»'ir  tcpt-      T  T  ^  *        ^P5F  P'T  T    '"ri    • 

CaAlLiixnALi       [  _L  j       t  aLoLiL/Ui-L,      KE.oO  (    it;  »•!    <  i  ^jliK,  VHr,      £\i^i.  •  1  .'.  i.'jt;ul,(    .  ■  .  •  . . 

r  t   rppjy  • 
-    -  •*  r 

.     >  r\      JLi  ■  bloi  1  /        .'fir,      A  >  1j  1  J  1  1\  ;    ; 
ji'.iuK    . .  ^  Li       [       j       r  a  i   LuJU  ,.L      n.UMji-v;.   _    (i...J>  .  •   n.i  1  uvjuKJ    , 


VAN  QUITFLAG:  BOOLEAN; 
I,J,PDEG:  INTEGER; 

v-  i.  -  v/  J.  —  *_  ^  U  4j  Li  jJ  ^  1  X  V>  Li  *    <.*  L  1  £  i  L\   a 
,  n  ,'-i  r>  t"-  -t> 

*  w  U'  l_i  £ 


INI:    CHAR; 
2AEEL:  STRING; 
c-4  :   IN  1  LiGEi^; 

rp  T'  17  r>  .        r  •  •  n  7  r>  -i  r,  . 

j.  i -.  j_i  ».  v  •  1  L  1   I    i_  •  J  .j  .A   #- 

L  i^v^ftLiL  .       Li  »  ^  i  i.  ( 
111.  ■         UlCii) 

TINIT:  INTEGER; 
TALU,TB: MATRIX; 

PROCEDURE  SAXB(SND,3N,SM: INTEGER;VAR  SA: MATRIX; VAR 

VAX    SINIT: INTEGER; VAR    SJN : LISTI ; VAR 

L    t   <j    I      .  ■  .   .         1  L  ■  1  ij  SJ  Li  I\  , 

~  — /   f   *-/  ^~  ~       J  ^J   •  jK      1  i.  ^ 

3EGIN     (*    SAX3    *) 


.j  O  /  O  A 


MATRIX; 
NTEGEi'  )  ; 


7    -■        r1  T  *  T  T  m n       '  ~  '  T  TT  M 

Li      l>  i    II  1-v      i  1 1  L   i 
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RLUD (SND,SN,SKER,SA,SJN, SCALE) ; 
IF    SJII[SN]=0    THEN 
BEGIN 

3KER  :=  3; 

WRITELN; 

NRITELN('IN  SAXE,  LU  DEC  3MP0S  I T  I  o::  OF  P 


'  > 


J7EITELN(  'YIELDED-  A    ~T'tO:;L:-. 
'-  ETELN  (  '  SOLUTION     3QE3    NCT 
SPACEBAR; 


U     .     A    JNIQUE     '  )  ; 


END; 


EXIT; 
END; 
f:r    J:=l    TO    311    DO 

ben:-; 

FOE    I:=l    T" 

QiJ   l  1  J         •  O  £j   ]_  J.  ^  kj   J    ^ 

FOE    I:=l    TO    MI     CO 
SX[I,J]      :=    EB[I] ; 
END; 
fRITELN; 
RED;      (*     3AXB    *) 

3EGIH(*     TTSAXB    *) 
CLEAR3CREEN; 
MT:  =    ICMDIM; 
.  T:  =    I CM; 

THI  IT    :=    G; 

FOR    I:=l    TO    NT    DO 

FOR    J:=     I    TO    NT    CO 

TALL1  [I,  J]      :=    IOTA  [I,  J]  ; 
?r'?.     J:=l    TO      IT    DO 

7o.~p     t  «=l     '"'^     •"rri    n.i 

1 2  [  I ,  J  j  .  -  [  V,-  j.  3  [  I ,  J  J  ; 
CLEARSCREEN; 

,-JRITELN  (  '  PLEASE  NAIT  '  )  ; 

3AXB ( NT , NT , MT , TALU , TB , XX ,TINIT , T IN , TKER) ; 
CLEARSCI EEN ; 

if  tker=o  then 

BEGIN 

FOR  J:=l  TC  MT  DO 
BEGIN 

writelmcthe  solution  fcr  COLUMN  '  ,J,'  IS  '); 

FOR  I:=l  TO  NT  DC 
BEGIN 

NRITE( ' [ ' ) ; 

NEITR(XX[I,J] ) ; 

nritelnC]  ')  ; 

END; 
tfRITELN; 


53 


END; 

WRITELN; 

WRITE ('DO  YOU  tfANT  A  HARDCOPY?  Y/N  '); 

IF  YES  THEN 

HARDCOPY (2)  ; 


END; 


2ND;     (* 

' C  n  "?  '  r  n 


) 
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(*  VERSION  12  8  3  *) 

(*  POLYRCOT  MODULE  *) 

MODULE  CVERLAY21; 
CONST  MAXDEGPl  =  21; 


lii-t   LJ  J 


IAIN1  =  1.  .20; 


DOMRP1  =  1..MAXDEGP1; 

MATRIX  =  ARRAY [DOMAIN1 ,DOMAINl]  OF  REAL; 
LISTI  =  ARRAY [DCMAINl]  OF  INTEGER; 
LICTR  =  ARRAY [DOMAIN1]  OF  REAL; 
LISTRP1  =  ARRAY [DOMRP1]  GF  REAL; 

EXTERNAL  PROCEDURE  CLEARSCREEN; 

EXTERNAL  PROCEDURE  CLEARIT ( I : INTEGER) ; 

EXTERNAL  PROCEDURE  INTREAD(VAP  K: INTEGER 

EXTERNAL  PROCEDURE  SPACEBAR; 


EXTERNAL  [5]  PROCEDURE  HQF.2  ( MM ,  N  ,  LON,  IGH  :  INTEGER ;  VAR  Pi:  MATRIX;  V 

./R ,  .71  : 


LISTR;  VAR  Z: MATRIX;  V: 


lu<  :  j. 


EXTERNAL  [6]  PFOCEDURE  BALANCE (NM , N : INTEGER ;  VAR  A:MATRIX;  VAR  LC 

REM: 
INTEGER;  VAR  SCREE:  LISTR; ; 

EXTERMAL  [6]  PROCEDURE  SLMHES (MM , N , LCN , IGH : INTEGER ;  VAR  ArMATRIX; 

VI  R  ENT: 
LI  ST  I)  ; 

EXTERNAL  [6]  PROCEDURE  ELTRAN (NM , N , LOv? , IGH : INTEGER ;  VAR  A: MATRIX; 

JN:  LISTI; 
VAR  Z:  MATRIX) ; 

PROCEDURE  TTRPQR; 

VAR  QUITFLAG:  BOOLEAN; 

I,J,PDEG:  INTEGER; 

CHOICE, SELECTION:  CHAR; 

PRCOEF:  LISTRP1; 

RMI,7RR:  LISTR; 

TIERR,NDEG:  INTEGER; 

CII:  CHAR; 

CREEL:  ATRIUM; 

94  :  INTEGER; 

TA3SERR,TRELERR:  LISTR; 
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TKLUST:  LISTI; 
N1,TKER:  INTEGER; 


PROCEDURE  R3ND2  (RN:  INTEGER ;C0EF:LISTEP1;  R-JR,RWI  :LI3TR; 

VAR  A3*SERR,RELEER:LISTR;VAR  KLUST : LISTI ; 

VAR  XE^  :  ViEZGES)  ; 

VAR  I, J, JP1, JR,K,M,NHl,NPl:  INTEGER; 

S, CERT, D I ST, EMAC, MAG, GLDERR,?, POWER, R, RAT, 
SVR  ,  SVI  ,  [JNCERT  ,  VF: , VI , VT,  XMAG  ,  XI ,  XR  :  REAL  ; 
SHRUNK:  BOOLEAN; 

FUNCTION  CPABS (XR,YR:REAL) :  REAL; 
BEGIN  (*  CPABS  *) 

CPABS  :=  SQRT ( XR* XR+YR* YR) ; 
END; 


FUNCTION  AMAX1 (A,B:REAL) :  REAL; 
BEGIN  (*  M-IAX1  *) 
IF  A<3  THEN 

AMAX1  :=  E 
ELSE 

"'•  1 r-  X ]  :  =  *-  * 
Si E;   (*  AMAX1  *) 

FUNCTION  SINGLE (VALUEtREAL) :  FEEL; 
ELGIN  (*  SINGLE  *) 
SINGLE  :=  VALUE; 
ELD;  (*  SINGLE  *) 

FUNCTION  DOUBLE (VALUE: REAL) :  REAL; 

BEGIN  (*  DOUBLE  *) 
E  JBLE  : =  VALUE; 
END;  (*  DOUBLE  *) 


PROCEDURE  EECHALF; 
VAR  J,K:  INTEGER; 
BEGIN  (*  EECHALF  *) 
FOR  J:=l  TO  RN  SO 

!  T 


=   i; 


Jin 

TDTfniT  /   ' 
iU\i    lb(         .    . 

KLUST [J] 

XMAG  :=  CPABS (RWR[J] ,RWI [J] ) ; 

EMAG  :=  ABSERR[J] ; 

IF    EHAG=0.0    THEN 

R     :=    0.0 
ELSE 

'EG  IN 

I  J      a!  Liu  —  U  •  U      -  n  ij  ii 

R    : =    —1.0 
ELSE 

R     :=    EMAG/XMAG; 
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END; 

relerr[j]  :=  r; 
end; 

NM1  :=  RN-1; 
FOR  J:=l  TO  NM1  DO 
BEGIN 

iRITE(  '...'); 

J  ?  I    :  =    J  + 1 ; 

FOR    K:=JP1    TO    ?.N    DC 

J£.Ol  tJ 

01  ST     :=    0PAB3(RWR[J]-RWR[K]  ,RWI  [J]-RWI  [JO 
I?    DIST<= (ABSERR[J] +A3SERR[K] )     THEM 
BEGIN 

KLUST[J]      :=    XLUSTTJJ+I; 
KLUST[K]     :=    KLUST[K]+1; 
END; 
END; 
END; 
I'  E  R    '.  —    0  ; 
!D;      (*     SECHALF    *) 


GIN  (*  R 

D 

NO 

n 

WRITELM; 

IF  RN<1 

T 

rJ  r 

;,i 

BEGIN ' 

r  OR 

: 

= 

—  i 

WRIT 

E 

T    %1 

(' 

3  P  A  C 

h\ 

o  t\ 

EXIT 

r 

'EGREE)     MUST 


=    1  '  )  ; 


NP1  :=  RN+1; 
POWER  :=  1.0/RN; 
P  :=  <\3S(C0EF[1]  )  ; 
IF  P=0.0  THEN 
BEGIN 

KER  :=  2; 

WRITELN (' LEADING  COEFFICIENT  IS  ZERO.1); 

SPACEBAR; 

EXIT: 


RAT  :=  ABS (C0EF[NP1] )/P; 
RAT  :=  RAT*EXP( (-4  5.C) *LN(2.0) ) ; 
FOR  JR:  =  1  TO  RN  00 
3 EG  IN 

WRITE  ('  ...'); 
XR  :=  DOUBLE (RWR[JR] ) ; 
XI  :=  DOUBLE (RWI  [JR]  )  ; 
VR  :=  DOUBLE  (CO)  ; 
VI  :=  DOUBLE (0.0)  ; 
FOR  J:=l  TO  NPl  DO 
BEGIN 

..?  ;TE(  '...'); 

VT  :=  XR*VR-XI*VI+D0U3L3(CCEF[J] ) ; 

VI  :=  XR*VI+XI*VR; 
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VR  :=  VT; 
END; 
3VR  :=  SINGLE (VR) ; 
SVI  :=  SINGLE (VI) ; 
MAG  :=  CPA33 (SVR,SVI) ; 
3  :=  A  1AX1 (RAT,:iAG/P) ; 
RELERRfJFE]  :=  3;' 

^23ERR[JR]   :=  EXP ( FOWER*LN (3) ) ; 
E :  ID  ; 
3HRU  IK  :=  FALSE; 
REPEZ T 

/RITE( '...'); 
SHRUNK  :=  FALSE; 
FCR  J:=l  TC  EH  DO 
BEGIN 

IF  A3SERR[J]  OO.O  THEM 
BEGII! 

?  :  =  1 .  C ; 
M  :=  RN; 

FOR  K:=l  TO  OH  DC 
JEGIU 

/  v  rt  I  1  il  v   •  •  •   )  / 

IF    KOJ    THE"] 
BEGIN 

DIST     :=    CPABS  (Rv7R[  J]-RWR[K]  ,RWI  [J]-R\ 

=  AESHER [K] ; 
USER 
IF  CERT>=  A2SERR[J] -THEN 
BEGIN 

P  :=  ?*CERT; 


I[K])  ; 


EE 
CERT  :=  DIGT-UNCERTj 


END; 
END; 
END; 
OLDERR  : =  A3SERR[J] ; 
A3SERR[J]  :=  RELERR[J]/P; 
IF  .1>1  THEN 

:ESEER[J]   :=  EXP ( (I.O/M) *LN (A3£ERR[J] ) ) ; 
IF  ASSERR[J] <CLDERR*0.99  THEN 
SHRUNK  :=  TRUE; 

V  \!  n  • 

^j  w  ^  f 

UNTIL  SHRUNK=FALSE; 
SECHALF; 
ESS;   (*  RBND2  *) 

PROCEDURE  RPQR(RNDEG: INTEGER;  CCEF : LISTRPl ;  VAR  RIERR: INTEGER; 

VAR  RWI,RWR:LISTR) ; 

VAR  J, K,RLGW,RIGH:  INTEGER; 

REC I P :  REAL; 
RA,RVEC:  -IATRIX; 

EE  :  Z~~RLA~  [  C  C  ]  ; 
CH:  S  {AR; 
RSCALE:  LISTR; 
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RINT:  LI  ST  I; 

BEGIN  (*  RPC.R  *) 

RIERR  :=  0; 
IF  COEF[l] -0  THEN 
BEGIN 

:\  x  L  i\  x\   .  -   .  , 

nriteln ( 'leading  gceff 

3PACE3AR; 
EX  I  T; 
END; 
IF  CCEF [1] =0.C  THEN 

RECIP  :=  L.O 
ELF.E 

RECIP  :=  1.0/COEF  [1]  ; 
FCR  K:=l  TO  RNDEG  DC 
BEGIN 

RAfl.Kl   :=  -COEF fK+11 *RECI? 


r>  - 


v>  ^  „  i  *->  i_j  \ —  j  ^j 

BALANCE  (RNDEG,  RNDEG  , RA , RLOW, RIGH , RSCALE )  ; 

ELMHES  ( RNDEG  ,  RNDEG,  RLOW , RIGH , RA ,  R  INT)  ; 

ELTRAN  (RNDEG,  RNDEG,  RLOV7,  RIGH,  RA,  RINT,  RVEC)  ; 

HQR2  (RNDEG,  RNDEG  , RLOW, RIGH , RA , RWR , RWI  ,  RVEC,  RIERR)  ; 

IF  RIERROC  THEN 


R I  S  R  r 
,v'RI  TEEN 

p  V  T  T>  • 

La!  1   , 

riip  > 
END;      (*     RPOjR    *) 


.  -       -L, 


RPQR' ) 


BEGIN  (*■  TTRPQR  *) 
CLEARSCREEN; 
REPEAT 

CLEARIT (1)  ; 

•7RITE  (  'WHAT  IS  THE  DEGREE  CF  THE  POLYNOMIAL?  '  ); 

INTREAD  (NDEG)  ; 
UNTIL  ((NDEG>0)  AND  ( NDEG<=  1AXDEG )  )  ; 
FDEG  :  =  NDEG+1; 
FOR  I:=l  TO  .4AXDEGP1  DO 

PRCCEFfI]  :=  CO; 
CLEARIT  (C)  ; 
WRITELN( 'ENTER  COEFFICIENTS  CF  POLYNOMIAL  TERMS: 


7EITE  (  ' 
GETPOLCOF (PDEG, PRGOEF)  ; 

hRITELN  ('  PLEASE  WAIT  '); 


')  ; 


por^"!;  7T 


RPQR (NDEG, I 

CLEAR3CREEN; 

IF  TIERR=0  THEN 


1  i  ll.  i\  i\ 
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BEGIN 

./RITELN; 

WRITELN( 'THE  ARRAY  OF  COMPLEX  ROOTS  IS'); 
WRITELN; 

ECR  I:=l  TO  NDEG  DO 
BEGIN 

;vRITS('['); 

write  (twr  [I] )  ; 
KRITEC  ,')  ; 
,-JRITE(T'.7I  [I]  )  ; 
JRITELN('  ]  '  )  ; 

e::d; 

WRITELN; 

SPACEBAR; 

R3ND2  (NDEG,  FRCOEF  ,TWR,  TV7I  , TA3SERR,  TRELERR,  TKLU3T  ,  TK] 

ivRITELN; 

vjRITEL'J  ] 

FOR     I:=l    TO    NDEG    EC 
nEGi:i 

,:?.ITE  ('['); 
.7RITE  (TA3SERR  [  I  j  )  ; 

i7eiteln('  ]  ')  ; 
END; 

vjriteln; 

2nd;    (*   ttrpqr  *) 

!cce;io. 


)  ; 
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(*  VERSION  0207  *) 
MODULE  OVERLAY23; 

EXTERNAL  PROCEDURE  GOTOXY (X , Y : INTEGER) ; 

EXTERNAL  PROCEDURE  CLEASSCREEN; 

EXTERNAL  FROCEDURE  SPACEBAR; 

PROCEDURE  KELP; 

TYPE  STRNG40  =  STRING[40]; 

VAR  I  UFO  :  /•  RRAY  [  1 .  .  1  2  ]  OF  STRNG4  0  ; 
I:  INTEGER; 


BEGIN  (*  HELP 
INFO [1] 
INFO [2] 
I  IFO  [3] 
INFO  [4] 

n;?o[6] 

INFO  [7 ] 
I HFC  [S] 
[NFC  [3] 
INFO[9] 
INFC  [10] 


TO  DO  MATRIX  iJORK  CUE   1UST  FIRST  KZ' 
IN  A  MATRIX  "A".  UITH  THIS  CUE  SAN' 
CALCULATE  ITS  EIGENVECTORS,  EIGEN-1- 
VALUES,  INVERSE  OR  DETERMINANT.    '; 

TO  SOLVE  A  OYSTE  I  OF  SIMULTANEOUS  ' 

"r-rPT'i"^      "A"    nr  ipp    II  -t  It    _    II  -i  II    I  . 

^vr     '  \  r T  ^  T      at  pn      T  r  *?  v      t  \t      ~       *  *  *\  <v  r>  t  ■* r      n^  m       i 
Ui.iLi       lUol     .-j-L.j>^     Kjji      L IM     /J!     .]■'.  1'hlA         Li      . 

i  . 


INFOQ1] 


=  'THIS  MATRIX  "3"  MAY  EE  KEYED  IN  a.F 
=  'THE  MATRIX  "A"  HAS  SEEN  KEYED  IN  A 

o  Li  ij  A  i\  »d  v—  H  lit  ij  lj  ; 

GOTCXY (0,0)  ; 

NRITE ( 'DIRECTIONS  FOR  INPUT:   '); 

GOTCXY  (0,3)  ; 

FOR  I  J  =  1  TO  12  DC 

K  ITELN ( INFO  [I] )  ; 
GOTOXY (0,20)  ; 
OFACOOAR; 
END;   (*  KEEP  *) 

HOD END. 


WD    '; 
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(*  VERSION  0236  *) 

MODULE  OVERLAY24; 

(*  EIGENVEC  MODULE  *) 

TYPE  DCMAINI  ='  1. .20; 

MATRIX  =  ARRAY [DOHAINl, DCMAINI]  OF  REAL; 
LI3TI  =  ARRAY  [DGMAINl]  OF  INTEGER; 
LISTR  =  ARRAY [DOMAIN1]  OF  FEAL; 


VAR  IONDIM:  EXTERNAL  INTEGER; 

IOTA,TVEC:  EXTERN; L  MATRIX; 
TEVR,TEVI:  EXTERNAL  LIGTR; 


EXTERNAL  PROCEDURE  CLEARSCREEN; 
EXTERNAL  PROCEDURE  SPACERAR; 
EXTERNAL  FUNCTION  YES:  BOOLEAN; 


EXTERNAL  [5]  PROCEDURE  NQR2  (  NM  ,  N  ,  LOW  ,  I  GR  :  INTEGER  ;  VAR  H:M/.TRi:. 

.  ,  MI  : LISTR; 
VAR  Z:MATRIX;VAR  IERR: INTEGER) ; 

EXTERNAL  [6]  PROCEDURE  BALANCE ( MM , N : INTEGER ; VAR  A:MATRIX;VAF  AC 

.    t  >-r  rp  T7  f>  T?  D  • 

.  x  .. .  1  „ '  j  i-.  r\  , 

VAR    SCALE :LISTR) ; 

EXTERNAL     [6]     PROCEDURE    ELMIIES  (MM  ,  N  ,  LOW,  IGH  :  INTEGER ;  VAR    A:iATRIX; 

INT:Li:TI) ; 

EXTERNAL  [G]  PROCEDURE  SLTRAN ( NM , N , LOW , IGH : I NTEGER ; VAR  A:MATRTX; 

LI  ST  I ; 
VAR  Z : MATRIX) ; 

EXTERNAL  ['5]  PROCEDURE  BALBAK  (  MM  ,  N  ,  LOW,  IGH  :  I  MTEGER  ;  SCALE  :  L  I  STR;^ 

INTEGER; 

VAR  Z : MATRIX) ; 

EXTERNAL  [2]     PROCEDURE  HAPDCOPY ( HNUM : INTEGER) ; 

PROCEDURE  TTRNAA; 

VAR  QUITFLAG:  BOOLEAN; 

I, J,PDEG,NDIM:  INTEGER; 
CHOICE, DELECT  I  ON:  CHAR; 
TCOEF:  LISTR; 
T,JI,TWR:  LISTR; 
TIERR,NDEG:  INTEGER; 
wilt   »-ii.ii.  f 
SREEL:  STRING; 
P4:  INTEGER; 
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TA:  MATRIX; 


PROCEDURE  RNAA(RNDIM, RN : INTEGER ;VAR  RA : MATRIX ;VAR  REVR,REVI :LISTR; 

VAR  RVEC: MATRIX ;VAR  RIERR : INTEGER) ; 

VAR  5S:  STRING; 

RSCALE:  LISTR; 

r  T  > T  rn  .   ]"  T  C  r~<  t  . 

i-   i.  IN  i  •    Li  1  ^  l  1  ^ 

I,  J,RL0Vv7,RIGH:  INTEGER; 
CH:  CHAR; 


PROCEDURE  ERRMSS2 ; 
BEGIN  (*  ERRMSS2  *) 

NRITELN ( 'MORE  THAN  ICO  QR  ITERATIONS  NEEDED  ') 

i7RITELN( 'FOR  SOME  EIGENVALUE  IN  RNAA .  '  )  ; 

SPACEBAR; 

EXIT; 
END;  ("*  ERRMSS2  *) 


BEGIN  (*  RNAA  *) 

BALANCE ( END  IN , RN , RA , RLCW , RICH , RSCALE )  ; 

ELMHEE  (  RNDIM  ,  EN  ,  R.LON  ,  R  I  GH  , RA , RINT)  ; 

ELTRAN  (RNDIM,RN,RLOU,RICK,  RA  ,  RINT  ,  RVEC  )  ; 

HQB2  (RNDIM,RN,RLON,  RICH  ,  RA  ,  REVR  ,  REVI  ,  RVEC,  EI  ERR) 

IE  (RIERROO)  THEN 
ERRMES2; 

3 ALEAK ( RNDIM, RN,RLOW,RIGH, RSCALE, RN , RVEC) ; 
END;   (*  RNAA  *) 

PROCEDURE  PRVECTORS; 
VAR  I:  INTEGER; 

BEGIN  (*  PRVECTORS  *) 

J  :=  1; 

REPEAT 


BEGIN 


NRITELN  (  'VECTOR  '  ,J,'  'HAS  COMPONENTS  '); 

FOR  I :=1  TO  NDIM  DC 
BEGIN 

NEITE ( 'VECTOR' , J, ' [ ' ,1, ' ] =' , ' [ ' , TVEC [I 
NRITELN  (  '  ,  '  ,TVEC[I,J  +  1]  ,']'); 
END; 
WRITELN; 

spacebar; 

iriteln; 
nriteln ( 'vector    ',j+1,'    has  components    '); 

ECR  I:=l  TO  ED  IE  DO 
BEGIN 

.< Li  1  I  L  {     V h.  _  i  U I\  ,  J  +  i  ,   I  ,  x  ,      J  -   ,   [   ,!'•'"- 
NRITELN  (  '  ,  '  ,-TVEC [I , J  +  l]  ,']'); 

END; 


,J] 


i ,  J  ] )  ; 
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WRITELN; 

J  :  =  J  +  2  ; 
END 
ELSE 
BEGIN 

WRITELN ( 'VECTOR  '  ,J,'  HAS  COMPONENTS  '); 

FOR  I  :  =1  TC  ND-IM  EC 

WF  ITE  (  '  VECTOR  '  ,  J  ,  '  [  '  ,  I  ,  '  ]  =  '  ,  '  [  '  ,  TVE  :  [  I  ,  J]  )  ; 
WR ITELN  (  '  ,  0  .  0 0 0 0.0 (  000 0 000 OE+00 0 ]  '  )  ; 

LlLtLJ  i 

J    :=    J+l; 
END; 
SPACEBAR; 

WRITELN; 
UNTIL  J>NDIM; 
END;  (*  PRVECTORS  *) 


begin (*   ttrnaa  *) 
:learscfeen; 
:::::. i    :=   iciidim; 

FOR  I : =1  TC  NDIM  DO 
FOR  J:=l  TO  NDIM  DC 

ta[i, j]  :=  iota [i, j] ; 
clearscreen; 

:;rite(  '  please  wait.  . . ' )  ; 
rnaa  ( nd  iil ,  nd im  ,  ta  ,  t  eve  ,  t  e  v i  ,  tvec  ,  t i  err)  ; 

■■;r->T'Til7r?7/'rPI-?7r   jnnjv   p  T   ',^-.tnr  ^V   T"T-,77-'T/-;\rnr'C   T  C  •  \  • 
1  j-  rpri-  -  ;  . 

FOE  I:=l  TO  NDIM  DC 
BEGIN 

WRITE ('  [')  ; 
WRITE (TEVR [I] ) ; 

H  1<  1 . 1  i,  {      ,      )   , 

write (tevi [i] ) ; 
:eiteln( • ] ' ) ; 

_i  WD  , 

7RITELN; 

SPACEBAR; 
WRITELN; 

;,TriTELN  (  'THE  COMPLEX  EIGENVECTORS  ARE  '); 
7RITELN; 
PRVECTORS; 
WRITELN; 

WRITE ('DO  YOU  WANT  A  HARD  COFY?  Y/N  '); 
IF  YES  THEN 
HARDCOPY (1) ; 
END; (*  TTRNAA  *) 

[■I  DEND. 
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